Koşullu arama ve renklendirme

[qbilay06]

Merhaba,

Belirli koşula göre arama ve uygun olmayan hücrelerin farklı renkte olacak şekilde biçimlendirilmesi ile ilgili sorunum için gerekli dosya ektedir.

Emeği geçen herkese şimdiden teşekkür eder tüm forum üyelerine saygılar sunarım.

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()
    Application.ScreenUpdating = False
    
    son = Cells(Rows.Count, "A").End(3).Row
    Range("B2:B" & son).Interior.Pattern = xlNone
    
    ReDim dizi(1 To 2, 1 To 1)
    For i = 2 To son
        If WorksheetFunction.CountIf(Range("A2:A" & i), Cells(i, "A")) = 1 Then
            s = s + 1
            ReDim Preserve dizi(1 To 2, 1 To s)
            dizi(1, s) = Cells(i, "A").Value
            For a = i To Cells(Rows.Count, "A").End(3).Row
                If Cells(a, "C") = "fert" Then
                    dizi(2, s) = Cells(a, "B").Value
                    Exit For
                End If
            Next a
        End If
    Next i
    
    For d = 1 To s
        For j = 2 To Cells(Rows.Count, "A").End(3).Row
            If Cells(j, "A") = dizi(1, d) Then
                If Cells(j, "B") = dizi(2, d) Then
                Else
                    Cells(j, "B").Interior.Color = 65535
                End If
            End If
        Next j
    Next d
    
    Application.ScreenUpdating = True
    MsgBox "B i t t i "
End Sub

. . .

 

[YUSUF44]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub aile()
For i = 2 To Cells(Rows.Count, 3).End(3).Row
    If Cells(i, 3) = "fert" Then
        no = Cells(i, 1)
        ID = Cells(i, 2)
        For j = 2 To Cells(Rows.Count, 1).End(3).Row
            If Cells(j, 1) = no And Cells(j, 2) <> ID Then
                With Cells(j, 2).Interior
                    .Color = 255
                End With
            End If
        Next
    End If
Next
End Sub

 

[qbilay06]

Sn Hüseyin Çoban ve Yusuf44,
ilginiz için ayrı ayrı teşekkür ederim.