Soru Çoklu koşul

[unur]

Günaydın Arkadaşlar;
Belki çok basit ama bulamadım.

A sütununda ve d sütununda verilerim var
Örnek A sütununda Ahmet D sütununda 55 yazıyor
Mükerrer kayıtları arayacağız her iki hücrenin değerlerine bakarak boyamak istiyorum
A sütununda Ahmet D sütununda 56 yazanı boyamayacak.
Yardımlar için şimdiden Teşekkürler

 

[Tevfik_Kursun]

Günaydın,
Deneyiniz ...

 

[Korhan Ayhan]

Merhaba,

Profilinizdeki sürüm bilgisi güncelse alternatif olarak deneyebilirsiniz.

A : D sütun aralığınız seçiniz.
Koşullu biçimlendirme menüsünden formül bölümüne geçiniz.

=TOPLA.ÇARPIM(($A$1:$A$1000<>"")*($A$1:$A$1000=$A1)*($D$1:$D$1000=$D1))

Sonrasında aynı ekranda BİÇİM butonuna tıklayıp dilediğiniz rengi vererek işlemi tamamlayınız.

Koşula uyan mükerrer hücrelere ait satırlar seçtiğiniz renge boyanacaktır.

Not: Eğer daha yeni sürümleri kullanıyorsanız bu formülü deneyebilirsiniz.

=ÇOKEĞERSAY($A:$A;$A1;$D:$D;$D1)

 

[htsumer]

VBA Olarak

Sub MükerrerKontrolVeBoyama()
    Dim ws As Worksheet
    Dim sonSatir As Long
    Dim i As Long, j As Long
    
    Set ws = ActiveSheet
    sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' Önce önceki renklendirmeleri temizleyelim
    ws.Range("A2:D" & sonSatir).Interior.ColorIndex = xlNone
    
    ' Her satırı diğer satırlarla karşılaştır
    For i = 2 To sonSatir - 1
        For j = i + 1 To sonSatir
            If ws.Cells(i, "A").Value = ws.Cells(j, "A").Value And _
               ws.Cells(i, "D").Value = ws.Cells(j, "D").Value Then
              
               ' Eğer eşleşirse her iki satırı da sarı renkle boyayalım
               ws.Range("A" & i & ":D" & i).Interior.Color = RGB(255, 255, 0)
               ws.Range("A" & j & ":D" & j).Interior.Color = RGB(255, 255, 0)
            End If
        Next j
    Next i
    
    MsgBox "Mükerrer kayıtlar boyandı!", vbInformation
End Sub

VBA Fonksiyon

Function MükerrerKontrol(adHücre As Range, degerHücre As Range) As Boolean
    Dim ws As Worksheet
    Dim sonSatir As Long
    Dim i As Long
    
    Set ws = adHücre.Worksheet
    sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    MükerrerKontrol = False ' Önce varsayılan FALSE
    
    ' Satırları kontrol et
    For i = 2 To sonSatir
        ' Kendi satırını atla
        If ws.Cells(i, "A").Address <> adHücre.Address Then
            If ws.Cells(i, "A").Value = adHücre.Value And _
               ws.Cells(i, "D").Value = degerHücre.Value Then
              
               MükerrerKontrol = True
               Exit Function
            End If
        End If
    Next i
End Function

Excel’de boş bir sütunda (örneğin E2) yazabilirsin:

=MükerrerKontrol(A2,D2)