VBA Excel - 如何删除基于两列的重复项

Question

Excel Example as I can't post pictures

我上传了一张带有一些示例的 excel 图片。 我需要的是：

• 第 3 行和第 4 行重复，但第 4 行在“Dir”列中有数据。在这种情况下，删除两者
• 第 12 行和第 13 行重复，“Dir”列中没有数据。在这种情况下，只留下一行

我使用条件格式突出显示重复项并使用“IF”“Countif”....但没有运气，也不知道如何完成此操作。

Answer 1

对于基于公式的方法（使用辅助列，您可以执行以下操作：

1. D2公式：=COUNTIFS($A$1:$A2,A2)
2. E2公式：=COUNTIFS($A$2:$A$33,A2,$C$2:$C$33,"LD")
3. F2公式：=IF(AND(COUNTIF($A$2:$A$21,A2)=1,E2=1),"Keep",IF(OR(AND(D2>0,E2>0),AND(D2>1,E2=0)),"Remove","Keep"))

向下拖动，然后过滤“删除”并删除可见单元格。

Answer 2

如果你想要一个 VBA 选项，那么下面的代码就可以了：

  Option Explicit

Sub DeleteDupes()

    Dim workingRow As Long
    Dim workingItem As String
    Dim i As Long
    Dim occurances As Variant

    'Skip past header row
    workingRow = 1

    Do Until Range("A" & workingRow + 1).value = ""

        workingRow = workingRow + 1
        workingItem = Range("A" & workingRow).value

        If Len(Range("C" & workingRow)) = 0 Then

            occurances = FncGetOccurances(workingRow, workingItem)

            If IsArray(occurances) Then

                FncDeleteRange (occurances)
                workingRow = workingRow - UBound(occurances)

            End If

        End If

    Loop

End Sub

Private Function FncDeleteRange(value As Variant)

    Dim deleteRange As Range
    Dim i As Long

    For i = 1 To UBound(value)

            If i = 1 Then

                Set deleteRange = Range("A" & value(i), "C" & value(i))
                deleteRange.Select

            Else

                Union(deleteRange, Range("A" & value(i), "C" & value(i))).Select

            End If
    Next i

    Selection.Delete Shift:=xlUp

End Function

Private Function FncGetOccurances(masterIndex As Long, value As String) As Variant

    Dim rowsToReturn As Variant
    Dim i As Long
    Dim currentCell As Long
    Dim itemCount As Long

    i = 1

    Do While Range("A" & i + 1).value <> ""

        i = i + 1
        currentCell = Range("A" & i).value

        If currentCell = value And _
            i <> masterIndex And _
            Len(Range("C" & i)) <> 0 Then

            itemCount = itemCount + 1

            If itemCount = 1 Then

                ReDim rowsToReturn(itemCount)

            Else

                ReDim Preserve rowsToReturn(itemCount)

            End If

            rowsToReturn(itemCount) = i

        End If

    Loop

    FncGetOccurances = rowsToReturn

End Function