满足 2 个条件时查找重复条目并标记它们

Question

当两列中的条件满足时，VBA 有没有办法找到重复的条目？

我有两列数据。第一列有日期，第二列有金额。问题是在对应列中查找并突出显示重复金额和相同日期的所有金额？

到目前为止，我已经设法找到一个代码来突出显示符合 1 个标准的重复项。

这里是代码

Sub RemoveDuplicateAmounts()
      Dim cel As Variant
      Dim myrng As Range

      Set myrng = Sheets("Sheet1").Range("D2:D" & Sheets("Sheet1").Range("D65536").End(xlUp).Row)
      myrng.Interior.ColorIndex = xlNone

      For Each cel In myrng
      clr = 10
        If Application.WorksheetFunction.CountIf(myrng, cel) > 1 Then
          cel.Interior.ColorIndex = 26
      clr = clr + 10

      End If
      Next

      MsgBox ("All duplicates found and coloured")

End Sub

Answer 1

这是对我给出公式的同一件事的 VBA 尝试。我认为没有必要，但无论如何，OP 可能会从中吸取教训。干杯！

Sub ertdfgcvb()
Dim LastRow As Long, DatesCol As Long, AmountsCol As Long, a As Double, b As Double
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
DatesCol = 4 'D column with dates
AmountsCol = 5 'E column with amounts
Columns(DatesCol).Interior.ColorIndex = xlNone 'dates lose color
For i = 1 To LastRow 'for each row
    If i <> 1 Then 'had some fun with row 0 error
        a = Application.WorksheetFunction.SumIfs( _
                  Range(Cells(1, DatesCol), Cells(i - 1, DatesCol)), _
                  Range(Cells(1, DatesCol), Cells(i - 1, DatesCol)), _
                  Cells(i, DatesCol), _
                  Range(Cells(1, AmountsCol), Cells(i - 1, AmountsCol)), _
                  Cells(i, AmountsCol)) 'counts the date values associated with recurrences before
    Else
        a = 0 'if it's first row I declared a zero, I don't know why
    End If

    If i <> LastRow Then 'yeah, last row stuff
        b = Application.WorksheetFunction.SumIfs( _
                  Range(Cells(i + 1, DatesCol), Cells(LastRow, DatesCol)), _
                  Range(Cells(i + 1, DatesCol), Cells(LastRow, DatesCol)), _
                  Cells(i, DatesCol), _
                  Range(Cells(i + 1, AmountsCol), Cells(LastRow, AmountsCol)), _
                  Cells(i, AmountsCol)) 'counts the date values associated with recurrences after
    Else
        b = 0 'if it's the last row, there are definitely none after
    End If

    If a <> 0 Or b <> 0 Then Cells(i, 4).Interior.ColorIndex = 26 'if either one of them isn't 0 then the date value gets a nice background color
Next i
End Sub

使用Countifs 并进行一些优化后，它将如下所示：

Sub ertdfgcvb()
Dim LastRow As Long, DatesCol As Long, AmountsCol As Long
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
DatesCol = 4 'D column with dates
AmountsCol = 5 'E column with amounts
Columns(DatesCol).Interior.ColorIndex = xlNone 'dates lose color
For i = 1 To LastRow 'for each row
If 1 < Application.WorksheetFunction.CountIfs(Range(Cells(1, DatesCol), Cells(LastRow, DatesCol)), _
                  Cells(i, DatesCol), _
                  Range(Cells(1, AmountsCol), Cells(LastRow, AmountsCol)), _
                  Cells(i, AmountsCol)) _
                  Then Cells(i, 4).Interior.ColorIndex = 26 ' 'counts the date values associated with occurrences if there's more than one then the date gets a nice background color
Next i
End Sub

Answer 2

=SUMIFS($D$1:$D1,$D$1:$D1,$D2,$E$1:$E1,$E2)+SUMIFS($D3:$D$1048576,$D3:$D$1048576,$D2,$E3:$E$1048576,$E2)

对于使用 VBA：

=SUMIFS(R1C4:R[-1]C4,R1C4:R[-1]C4,RC4,R1C5:R[-1]C5,RC5)+SUMIFS(R[1]C4:R1048576C4,R[1]C4:R1048576C4,RC4,R[1]C5:R1048576C5,RC5)

这些总和 D（假定为日期）基于给定行之前和之后的 D（日期）和 E（金额） .根据需要更改 C5 和 C4 以适合您的数据集。

要了解真/假陈述，我想说的是在前面加上 0<>：

=0<>SUMIFS(R1C4:R[-1]C4,R1C4:R[-1]C4,RC4,R1C5:R[-1]C5,RC5)+SUMIFS(R[1]C4:R1048576C4,R[1]C4:R1048576C4,RC4,R[1]C5:R1048576C5,RC5)