Sıfırdan büyükse renklendiren makro

[turkanet]

B sütununda aynı isimden birden fazla varsa ve bu aynı isimlerin karşılarındaki I satırlarının kimisinde A kimisinde B harfleri varsa, bu aynı satırların karşılığı O satırına "MU"; P satırına ise "ARB" yazacak makro için yardımınızı rica ederim.

[ataköylü-59]

B sütununda aynı isimden birden fazla varsa ve bu aynı isimlerin karşılarındaki I satırlarının kimisinde A kimisinde B harfleri varsa, bu aynı satırların karşılığı O satırına "MU"; P satırına ise "ARB" yazacak makro için yardımınızı rica ederim.

Sub yazz()
Dim i As Long
    For i = 2 To ActiveSheet.Cells(Rows.Count, "B").End(3).Row
        If WorksheetFunction.CountIf(Columns("B"), Cells(i, "B")) > 1 And (Cells(i, "I") = "A" Or Cells(i, "I") = "B") Then
            Cells(i, "O") = "MU": Cells(i, "P") = "ARB"
        End If
    Next i
i = Empty
End Sub

Ayrıca R1 hücresine =EĞER(VE(EĞERSAY($B$2:$B$15;B2)>1;I2="a");"MU";EĞER(VE(EĞERSAY($B$2:$B$15;B2)>1;I2="b");"MU";""))
         S1 hücresine =EĞER(VE(EĞERSAY($B$2:$B$15;B2)>1;I2="a");"ARB";EĞER(VE(EĞERSAY($B$2:$B$15;B2)>1;I2="b");"ARB";""))
         yazmak suretiyle de aynı işlemi yaptırabilirsiniz.           

[ataköylü-59]

İletiyi mükerrer olarak gönderdim birini, yani mesajın tamamını silmek istedim ama başaramadım. Sitede yeniyim bu yüzden bağışlayın lütfen!!!

[ataköylü-59]

İlgili dosya ektedir.