Sub AyniSatirlariSil3()
'Makro: Mesut Akcan
'22/8/2020
'makcan@gmail.com
'akcansoft.blogspot.com
'hiç bir garanti içermez
'tüm sorumluluk kullanıcıya aittir.
sr = Cells(1, 1).End(xlDown).Row 'son satır
For r = 2 To sr
    a = 0 'artan
    t = 0
    Do
        a = a + 1 'sonraki satır
        '1.sütunda, alttaki hücre ile eşit ise
        If Cells(r, 1).Value = Cells(r + a, 1).Value Then
            'toplam eşit hücre sayısı. 1.sütun
            t = t + 1
        Else
            'eşitlik yoksa döngüden çık
            Exit Do
        End If
    Loop
    a = 0 'artan
    t2 = 0
    If t > 0 Then '1. sütunda eşitlik varsa
        Do
            a = a + 1 'sonraki satır
            '2.sütunda alttaki hücre ile eşit ise
            If Cells(r, 2) = Cells(r + a, 2) Then
                'toplam eşit hücre sayısı. 2.sütun
                t2 = t2 + 1
                '2. sütunlardaki eşitlik 1. sütun sayısı kadarsa
                'döngüden çık
                If t2 = t Then Exit Do
            Else
                'eşitlik yoksa döngüden çık
                Exit Do
            End If
        Loop
    End If
    
    '1. ve 2. sütundaki eşit hücreler var ve aynı sayıdaysa
    If t > 0 And (t = t2) Then
        For x = 0 To t
            Cells(r + x, 3).Value = "X" '3. sütuna X yaz
            Xvar = True
        Next
    End If
    '1. sütundaki aynı hücre sayısı kadar satır atla
    r = r + t
    DoEvents
Next
If Xvar Then 'X işaretli satır varsa
    c = MsgBox("X işaretli satırlar silinsin mi?", vbYesNo)
    If c = vbYes Then
        For r = sr To 2 Step -1
            If Cells(r, 3).Value = "X" Then
                'Hücrede X varsa satırı sil
                Rows(r).Delete
            End If
            DoEvents
        Next
        msg = "Satırlar silindi!" & vbCr
    End If
Else
    msg = "Silinecek satır yok!" & vbCr
End If
MsgBox msg & "İşlem tamam"
End Sub

Sub AyniSatirlariSil()
'Makro: Mesut Akcan
'22/8/2020
'makcan@gmail.com
'akcansoft.blogspot.com
'hiç bir garanti içermez
'tüm sorumluluk kullanıcıya aittir.
sr = Cells(Rows.Count, 1).End(xlUp).Row 'son dolu satır
For r = 2 To sr
    a = 0 'artan
    t = 0
    Do
        a = a + 1 'sonraki satır
        '1.sütunda, alttaki hücre ile eşit ise
        If Cells(r, 1) = Cells(r + a, 1) Then
            eşit = True
            'toplam eşit hücre sayısı. 1.sütun
            t = t + 1
        Else
            eşit = False
        End If
    Loop Until eşit = False
    a = 0 'artan
    t2 = 0
    If t > 0 Then '1. sütunda eşitlik varsa
        Do
            a = a + 1 'sonraki satır
            '2.sütunda alttaki hücre ile eşit ise
            If Cells(r, 2) = Cells(r + a, 2) Then
                eşit = True
                'toplam eşit hücre sayısı. 2.sütun
                t2 = t2 + 1
                '2. sütunlardaki eşitlik 1. sütun sayısı kadarsa
                'döngüden çık
                If t2 = t Then Exit Do
            Else
                eşit = False
            End If
        Loop Until eşit = False
    End If
    '1. ve 2. sütundaki eşit hücreler var ve aynı sayıdaysa
    If t > 0 And (t = t2) Then
        For x = 0 To t
            Cells(r + x, 3).Value = "X" '3. sütuna X yaz
            tx = tx + 1
        Next
        '1. sütundaki aynı hücre sayısı kadar satır atla
        r = r + t
    End If
    DoEvents
Next
If tx > 0 Then 'işaretli satır varsa
    c = MsgBox("X işaretli satırlar silinsin mi?", vbYesNo)
    If c = vbYes Then
        For r = sr To 2 Step -1
            If Cells(r, 3).Value = "X" Then
                Rows(r).Delete 'satırı sil
            End If
            DoEvents
        Next
    End If
End If
MsgBox "İşlem tamam"
End Sub