Question

我使用此脚本，但如果行重复或不重复，则仅检查一列。

如何修改此项以检查多列（两个没问题）。

Sub merge_duplicates()
Dim count, count_1, found_str
count = 2
Do Until Range("A" & count) = ""
found_str = 0
For count_1 = 1 To count - 1
If InStr(1, Range("E" & count), Range("E" & count_1)) > 0 Then
Range("D" & count_1) = Range("D" & count_1) + Range("D" & count)
found_str = 1
End If
Next
If found_str = 1 Then
Rows(count).Delete
Else
count = count + 1
End If
Loop
End Sub

Example

提前致谢。

Answer 1

这种方式要快得多，首先查找范围中的最后一行，然后删除重复项。（比循环更快）

Sub test()

    Dim lastrow As Long

    With ThisWorkbook.Worksheets("Sheet1")
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lastrow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lastrow = 1
        End If

        'Array(1, 2, 16) means 1 - for A, 2 for B and 16 for P columns
        .Range("A1:P" & lastrow).RemoveDuplicates Columns:=Array(1, 2, 16), _
            Header:=xlYes
    End With
End Sub

在这里回答： excel: check for duplicate rows based on 3 columns and keep one row

根据多个列删除重复项并将其中一列相加

1 个答案: