Makro ile çarpma işlemi Yaptırma

[Emir Hüseyin Çoban]

Merhaba Arkadaşlar,

C sütununa B yazdığımda o satırda borç tutarına miktar x birim fiyat

C sütununa A yazdığımda o satırda alacak tutarına miktar x birim fiyat işlemini gerçekletirmeli.

Formülle yapmıyorum çünkü bazen miktar ve birim fiyata giriş yapmadan borç ve alacak tutarına veri girebilmeliyim.
Böyle bir işlemi yaptıra bilirmiyiz.

Yardım ve fikirlerinizi bekliyorum.

 

[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("C6:C65536")) Is Nothing Then Exit Sub
    If UCase(Target) = "B" Then
        Cells(Target.Row, "I") = Cells(Target.Row, "F") * Cells(Target.Row, "G")
        Cells(Target.Row, "J").ClearContents
    ElseIf UCase(Target) = "A" Then
        Cells(Target.Row, "J") = Cells(Target.Row, "F") * Cells(Target.Row, "G")
        Cells(Target.Row, "I").ClearContents
    Else
        MsgBox "Lütfen kayıt türü bilgisini giriniz !", vbCritical
    End If
End Sub

 

[Emir Hüseyin Çoban]

Korhan Hocam ilginiz için teşekkür ederim, kodlar çalışıyor ancak
B/A giriş yapıyorum daha sonra miktar ve birim fiyatı giriyorum, işlem sonuç vermiyor.
Geri gelip B/A tekrar yazınca işlemi gerçekleştiriyor.

 

[Emir Hüseyin Çoban]

Korhan Hocam ilginiz için teşekkür ederim, kodlar çalışıyor ancak
B/A giriş yapıyorum daha sonra miktar ve birim fiyatı giriyorum, işlem sonuç vermiyor.
Geri gelip B/A tekrar yazınca işlemi gerçekleştiriyor.

Hocam tekrar B/A sütununa geri gelmeden işlemi gerçekleştirmesi için kodlarla nasıl bir düzenleme yapmalıyım.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C6:C65536,F6:G65536")) Is Nothing Then Exit Sub
    If UCase(Cells(Target.Row, "C")) = "B" Then
        Cells(Target.Row, "I") = Cells(Target.Row, "F") * Cells(Target.Row, "G")
        Cells(Target.Row, "J").ClearContents
    ElseIf UCase(Cells(Target.Row, "C")) = "A" Then
        Cells(Target.Row, "J") = Cells(Target.Row, "F") * Cells(Target.Row, "G")
        Cells(Target.Row, "I").ClearContents
    Else
        MsgBox "Lütfen kayıt türü bilgisini giriniz !", vbCritical
    End If
End Sub

 

[Emir Hüseyin Çoban]

Teşekkür ederim Sy Korhan Ayhan, tam istediğim gibi olmuş. Sorunsuz çalışıyor.
İyi günler dilerim.