滚动浏览两列,查看差异并删除重复项

时间:2019-01-25 09:03:57

标签: excel vba

我使用下面的代码从xcol(第一个选定的列)中删除重复项,具体取决于第二列。使用2 for循环,我正在检查列1中的2个单元格和列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

1 个答案:

答案 0 :(得分:1)

在您的“ if”行中,与xCol交换Col!
使用“ 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