7'den Fazla Eğer Formulu VBA yapabilmek

[metehan8001]

Merhaba

Arkadaşlar şimdi burada anlatacagım belkı baslıkla farklı olabilir.

benim olayım şu m sütünü k sutunun de ki değerlere göre değer yazıyor.
ancak n sutununde sadece ek döküm yazısı varsa sadece onu yazıyor yoksa
k sutununde kı değere gore sonuc yazıyor.


değerlere gore yazılan
10150 Uzunsa 10090’a KES
10150 <> 8900 TAM BOY
8900 <> 7700 7600’e KES )
7700 <> 6600 KISA
6600 <> 4300 4250’e KES
4300 <> 4000 YARIM BOY
4000 <>0 HURDA
0 kucukse "boş"


Bu işlemi otomatik olarak formulsuz vba ile birlikte yapabilirmiyiz.

Yardımlarınızdan dolayı şimden teşekkürler.

 

[metehan8001]

7 adet eğer formulu

Arkadaşlar ben bu formulu M sutununa makro ile uygulamak istiyorum
yardımcı olabilirmisiniz.

EĞER(N461="EK DÖKÜM";"EKİ KES";
EĞER(K461<0;"boş";
EĞER(K461<4000;"HURDA";
EĞER(K461<4501;"YARIM BOY";
EĞER(K461<6600;"4500'YE KES";
EĞER(K461<7701;"KISA BOY";
EĞER(K461<8900;"7700'YE KES";
EĞER(K461<10151;"TAM BOY";
EĞER(K461>10150;"10090'a KES"))))))))

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu ilgili sayfanın kod bölümüne uygulayıp denermisiniz.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("H2:H65536,J2:J65536,K2:K65536")) Is Nothing Then Exit Sub
    If Cells(Target.Row, "N") = "EK DÖKÜM" Then Cells(Target.Row, "M") = "EKİ KES"
    Cells(Target.Row, "L") = 7.85 * Cells(Target.Row, "H") * Cells(Target.Row, "J") * Cells(Target.Row, "K") / 1000000
    If Cells(Target.Row, "K") < 4000 Then
        Cells(Target.Row, "M") = "HURDA"
    ElseIf Cells(Target.Row, "K") < 4501 Then
        Cells(Target.Row, "M") = "YARIM BOY"
    ElseIf Cells(Target.Row, "K") < 6600 Then
        Cells(Target.Row, "M") = "4500'YE KES"
    ElseIf Cells(Target.Row, "K") < 7701 Then
        Cells(Target.Row, "M") = "KISA BOY"
    ElseIf Cells(Target.Row, "K") < 8900 Then
        Cells(Target.Row, "M") = "7700'YE KES"
    ElseIf Cells(Target.Row, "K") < 10151 Then
        Cells(Target.Row, "M") = "TAM BOY"
    ElseIf Cells(Target.Row, "K") > 10150 Then
        Cells(Target.Row, "M") = "10090'A KES"
    End If
End Sub

 

[metehan8001]

Koray Bey,

Yardımlarınız İçin Teşekkür ederim, Çalışma istediğim gibi olmuş, Parmaklarınıza sağlık.

Sağ olun..

 

[metehan8001]

Koray Bey Sizden bir ricam daha olacak, ekli dosyada L sutundaki formulu de yukarda kı sekılde makro ıle yazabilirmisiz?
Şimdiden Çok sağ olun.

L sutununa yazılıcak formul: =7,85*H9*J9*K9/1000000

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. İncelermisiniz.

 

[metehan8001]

Tekardan selamlar.

Koran hocam öncelikle yardımların için gerçekten teşkkür ederim.


Olayım şu...
1) N Sutununde ki "ek döküm" yazısını görünce "eki kes" yazmıyor.
2) K sutunde boy degeri yazmıyorsa teorik ağırlık 0 (sıfır) değilde boş "" olsun.


Şimdiden Teşekkür ederim

 

[metehan8001]

Hepinize teşekkür ederim...

Koran hocam özellikle size.

yukarda istemiş olduğum iki maddeyi çözdüm, verdiğiniz kodları kendime göre uyarladım ve çok güzel oldu ayrıca süper çalışıyor.

Teşekkür ederim.

Option Explicit
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("H2:H65536,J2:J65536,K2:K65536")) Is Nothing Then Exit Sub
     
    If Cells(Target.Row, "N") = "EK DÖKÜM" Then
        Cells(Target.Row, "M") = "EKİ KES"
    ElseIf Cells(Target.Row, "k") < 1 Then
        Cells(Target.Row, "m") = ""
    ElseIf Cells(Target.Row, "K") < 4000 Then
        Cells(Target.Row, "M") = "HURDA"
    ElseIf Cells(Target.Row, "K") < 4501 Then
        Cells(Target.Row, "M") = "YARIM BOY"
    ElseIf Cells(Target.Row, "K") < 6600 Then
        Cells(Target.Row, "M") = "4500'YE KES"
    ElseIf Cells(Target.Row, "K") < 7701 Then
        Cells(Target.Row, "M") = "KISA BOY"
    ElseIf Cells(Target.Row, "K") < 8900 Then
        Cells(Target.Row, "M") = "7700'YE KES"
    ElseIf Cells(Target.Row, "K") < 10151 Then
        Cells(Target.Row, "M") = "TAM BOY"
    ElseIf Cells(Target.Row, "K") > 10150 Then
        Cells(Target.Row, "M") = "10090'A KES"
    End If
    
    If Cells(Target.Row, "K") < 1 Then
        Cells(Target.Row, "L") = ""
    ElseIf Cells(Target.Row, "K") > 1 Then
        Cells(Target.Row, "L") = 7.85 * Cells(Target.Row, "H") * Cells(Target.Row, "J") * Cells(Target.Row, "K") / 1000000
    End If

End Sub