İki farklı sütundaki degerlerin farkına göre işlem yapma

[muyat]

A sütunu
a1 100
a2 150
a3 175

B sütunu
b1 150
b2 200
b3 50

Örnegin B1-a1 farkı 50 olup bu 50 değerini C1 sutununa yazmasını ve yeşile boyamasını istiyorum
b3-a3 =125 değerini c3 sütununa yazmasını ve kırmızıya boyamasını istiyorum.
Şayet b sütunundaki ilgili hücredeki deger a sütunundaki aynı satırdaki hücrenin içindeki değere eşitse fark 0 olcagından 0 degerini yazıp sarıya boyamasını istiyorum
Yardımcı olur musunuz makro ile nasıl yapabilirim

 

[YUSUF44]

Anladığım kadarıyla aşağıdaki kodları deneyiniz:

Sub fark()
For i = 1 To Cells(Rows.Count, "A").End(3).Row
    If Cells(i, "A") < Cells(i, "B") Then
        Cells(i, "C") = Cells(i, "B") - Cells(i, "A")
        Cells(i, "C").Interior.Color = vbGreen
    ElseIf Cells(i, "A") > Cells(i, "B") Then
        Cells(i, "C") = Cells(i, "A") - Cells(i, "B")
        Cells(i, "C").Interior.Color = vbRed
    Else
        Cells(i, "C") = Cells(i, "A") - Cells(i, "B")
        Cells(i, "C").Interior.Color = vbYellow
    End If
Next
End Sub

 

[muyat]

Yusuf bey güzel çalışıyor.Teşekkürler
Yalnız ben bu işlemi yaptıktan sonra diyelimki hücreler boyandı..Sonrasında hücrenin birinin degerini değiştirince kırmızıya boyanması gerekirken boyanmıyor..
Yani istedigim o an herhangi bir hücrede değişiklik olursa makro otomatik çalışsın.Bu şekilde de düzenleyebilir misiniz programı

 

[muyat]

Aşagıdaki gibi ekleme yaptıgımda hücrede değişiklik yapınca excell kilitleniyor...Yardımcı olur musunuz

Private Sub Worksheet_Change(ByVal Target As Range)
For i = 1 To Cells(Rows.Count, "A").End(3).Row
If Cells(i, "A") < Cells(i, "B") Then
Cells(i, "C") = Cells(i, "B") - Cells(i, "A")
Cells(i, "C").Interior.Color = vbGreen
ElseIf Cells(i, "A") > Cells(i, "B") Then
Cells(i, "C") = Cells(i, "A") - Cells(i, "B")
Cells(i, "C").Interior.Color = vbRed
Else
Cells(i, "C") = Cells(i, "A") - Cells(i, "B")
Cells(i, "C").Interior.Color = vbYellow
End If
Next


End Sub

 

[YUSUF44]

Aşağıdaki kodları çalışma yaptığınız sayfanın adına sağ tıklayıp Kod görüntüle deyince açılan sayfaya yapıştırıp deneyin. O sayfada A1:B100 aralığında değişiklik ypatığında belirttiğiniz şekilde işlem yapar. Daha önceki kodları iptal edin/silin:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:B100")) Is Nothing Then Exit Sub
i = Target.Row
If Target = "" Then
    Cells(i, "C") = ""
    Cells(i, "C").Interior.Color = xlNone
ElseIf IsNumeric(Target) = False Then
    Cells(i, "C") = ""
    Cells(i, "C").Interior.Color = xlNone
    Exit Sub
ElseIf Cells(i, "A") < Cells(i, "B") Then
    Cells(i, "C") = Cells(i, "B") - Cells(i, "A")
    Cells(i, "C").Interior.Color = vbGreen
ElseIf Cells(i, "A") > Cells(i, "B") Then
    Cells(i, "C") = Cells(i, "A") - Cells(i, "B")
    Cells(i, "C").Interior.Color = vbRed
Else
    Cells(i, "C") = Cells(i, "A") - Cells(i, "B")
    Cells(i, "C").Interior.Color = vbYellow
End If
End Sub

 

[muyat]

Çok teşekkür edeirm