Прокрутка двух столбцов, просмотр различий и удаление дубликатов

Question

Я использую приведенный ниже код для удаления дубликатов из xcol (первый выбранный столбец) в зависимости от второго столбца. С помощью 2 для циклов я проверяю, идентичны ли 2 ячейки из столбца 1 и 2 из столбца 2, и ТОЛЬКО затем удаляю дублированную ячейку из столбца 1. Мой код удаляет все данные, независимо от того, есть дубликаты или нет. Есть идеи почему? Спасибо.

Sub RemoveDuplicates()
    Dim xRow As Long
    Dim xCol As Long
    Dim x2Row As Long
    Dim x2Col As Long
    Dim xrg As Range
    Dim xrg2 As Range
    Dim xl As Long
    Dim x2 As Long

    On Error Resume Next

    Set xrg = Application.InputBox("Select a range:", "Kutools for Excel", _
                                    ActiveWindow.RangeSelection.AddressLocal, , , , , 8)

    Set xrg2 = Application.InputBox("Select a range:", "Kutools for Excel", _
                                    ActiveWindow.RangeSelection.AddressLocal, , , , , 8)

    xRow = xrg.Rows.Count + xrg.Row - 1
    x2Row = xrg2.Rows.Count + xrg2.Row - 1
    xCol = xrg.Column
    x2Col = xrg2.Column
    'MsgBox xRow & ":" & xCol
    Application.ScreenUpdating = False

    For x2 = x2Row To 2 Step -1
        For xl = xRow To 2 Step -1
            If ((Cells(xl, Col) = Cells(xl - 1, xCol)) And (Cells(x2, x2Col) = Cells(x2 - 1, x2Col))) Then
                Cells(xl, xCol) = ""
            End If
        Next xl
    Next x2

    Application.ScreenUpdating = True
End Sub

Пример:

До:

Group  ID 
2010   16
2010   16
2010   15
2012   15

После (как должно быть)

Group  ID 
2010   16
2010  
2010   15
2012   15

Answer 1

В вашей строке if обменяйте Col на xCol!Используйте «Option Explicit», чтобы избежать подобных ошибок!

For x2 = x2Row To 2 Step -1
    For xl = xRow To 2 Step -1
        If ((Cells(xl, Col) = ...

После исправления этой ошибки ваш код выполняет следующие сравнения (что, я считаю, не то, что вы хотите сделать):

x2 xl   Compare 1   Compare2 
5  5    B5=B4       A5=A4
5  4    B4=B3       A5=A4
5  3    B3=B2       A5=A4
5  2    B2=B1       A5=A4
4  5    B5=B4       A4=A3   => DELETE
4  4    B4=B3       A4=A3
4  3    B3=B2       A4=A3   => DELETE
4  2    B2=B1       A4=A3
3  5    B5=B4       A3=A2
3  4    B4=B3       A3=A2
3  3    B3=B2       A3=A2
3  2    B2=B1       A3=A2
2  5    B5=B4       A2=A1
2  4    B4=B3       A2=A1
2  3    B3=B2       A2=A1
2  2    B2=B1       A2=A1

Чтобы напечатать сравниваемые адреса, я добавил следующие строки:

        If ((Cells(xl, xCol) = Cells(xl - 1, xCol)) And (Cells(x2, x2Col) = Cells(x2 - 1, x2Col))) Then
            Debug.Print x2; xl; Cells(xl, xCol).Address; "="; Cells(xl - 1, xCol).Address, Cells(x2, x2Col).Address; "="; Cells(x2 - 1, x2Col).Address; "=> DELETE"
            Cells(xl, xCol) = ""
        Else
            Debug.Print x2; xl; Cells(xl, xCol).Address; "="; Cells(xl - 1, xCol).Address, Cells(x2, x2Col).Address; "="; Cells(x2 - 1, x2Col).Address
        End If