Excel VBA 比较部分行并删除重复项

Question

我需要比较 2 行中的部分数据，并从 1 行中清除数据。我无法完全删除任何行。由于我文件的大小，公式不是首选（尽管过去几年我花费了数小时过滤和删除）。

我有一个庞大的文件，超过 100,000 行。前 18 列包含标识符，不能删除。接下来的 30 列（变量）包含零星数据。大部分表格是空白的。

由于数据输入问题，部分（但不是全部）数据与前一行重复。使用前 18 个字段中的特定列，我可以确定哪些行可能相似。

我需要代码说： 如果 A 行和 B 行中的这 3 个（非连续）列相同，则将第 19 列中的全范围数据与 Last Col 进行比较。比较 A 和 B 并删除第 2 行。移动到下一行。

我有一次删除一个单元格的工作代码。但我实际上不能相信单细胞比较 - 我真的需要查看该记录的整个数据集是否与之前的记录重复。鉴于这个问题，加上数据中空白单元格的数量，我相信我需要创建行数据的串联以进行比较或使用数组。我找不到这样对我的数据集有意义的代码。

Sub DeleteCopyData()

    Dim ws As Worksheet
    Set ws = Application.ActiveSheet

    Dim c As Range

    Dim lRow As Long, lCol As Long
    Dim cStart As Range
    Set cStart = Range("A1")

    'Find last row & column.
    lRow = ws.Cells(ws.Rows.Count, cStart.Column).End(xlUp).Row
    lCol = ws.Cells(cStart.Row, ws.Columns.Count).End(xlToLeft).Column

    With ws
        For i = lRow To 2 Step -1
            'If identifiers in Col 11, 3, and 6 are the same, and the data in Col 24 is the same, clear the duplicate row data.
            If .Cells(i, 11) = .Cells((i - 1), 11) And _
                .Cells(i, 3) = .Cells((i - 1), 3) And _
                .Cells(i, 6) = .Cells((i - 1), 6) And _
                .Cells(i, 24) = .Cells((i - 1), 24) Then     'This needs to be a range or an array of some kind.
                .Cells(i, 24).Clear
            'The 2 lines above this work for one cell, but I need it to compare all data from Col 19 to lCol.
            'If data is the same, clear the duplicate data in row i from Col 19 to lCol.
             End If
        Next i
    End With
End Sub

Answer 1

未经测试，但这应该很接近：

已编辑 - 使用 Exit Sub 而不是 Exit For

Sub DeleteCopyData()

    Dim ws As Worksheet
    Dim c As Range
    Dim lRow As Long, lCol As Long
    Dim cStart As Range
    Dim arr, i As Long, n As Long, rowmatch As Boolean

    Set ws = Application.ActiveSheet
    Set cStart = ws.Range("A1")

    arr = Array(3, 6, 11) 'first set of columns to test for match

    'Find last row & column.
    lRow = ws.Cells(ws.Rows.Count, cStart.Column).End(xlUp).Row
    lCol = ws.Cells(cStart.Row, ws.Columns.Count).End(xlToLeft).Column

    With ws
        For i = lRow To 2 Step -1

            rowmatch = True

            'perform the initial match on 3 cols...
            For n = LBound(arr) To UBound(arr)
                If .Cells(i, arr(n)) <> .Cells((i - 1), arr(n)) Then
                    rowmatch = False
                    Exit For
                End If
            Next n

            'got through the first tests - look at the cells starting in col 19
            If rowmatch Then
                For n = 19 To lCol
                    If .Cells(i, n) <> .Cells((i - 1), n) Then
                        rowmatch = False
                        Exit For
                    End If
                Next n
            End If

            'no mismatches, so clear from col 19 to end of row
            If rowmatch Then .Range(.Cells(i, 19), .Cells(i, lCol)).ClearContents
        Next i
    End With
End Sub

Answer 2

Sub DeleteCopyData()

    Dim ws As Worksheet, lRow As Long, lCol As Long, cStart As Range, C As Range

    Set ws = Application.ActiveSheet
    Set cStart = ws.Range("A1")

    'Find last row & column.
    lRow = ws.Cells(ws.Rows.Count, cStart.Column).End(xlUp).Row
    lCol = ws.Cells(cStart.Row, ws.Columns.Count).End(xlToLeft).Column

    With ws
        For i = lRow To 2 Step -1
            'If identifiers in Col 11, 3, and 6 are the same, and the data in Col 19:28 is the same, clear the duplicate row data.
            If .Cells(i, 11) = .Cells((i-1), 11) And _
                .Cells(i, 3) = .Cells((i - 1), 3) And _
                .Cells(i, 6) = .Cells((i - 1), 6) And _
                Join(Application.Transpose(.Range(.Cells(i, 19), .Cells(i, lCol))), Chr(0)) = _
                Join(Application.Transpose(.Range(.Cells(i-1, 19), .Cells(i-1, lCol))), Chr(0)) Then
                .Range(.Cells(i, 19), .Cells(i, 28)).Clear
             End If
        Next i
    End With
End Sub