当满足2个条件并标记它们时，查找重复的条目 [英] Find Duplicate entries when 2 criteria met and mark them

问题描述

我有两列数据，在VBA中有一种找到重复条目的方法吗？第一列有日期，第二列数量。问题是找到并突出显示相应列中的重复金额和相同日期的所有金额？

我已经设法找到一个代码来突出重复一个条件。

这里是代码

  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 
 
对于每个cel In myrng 
 clr = 10 
如果Application.WorksheetFunction.CountIf（myrng，cel）> 1然后
 cel.Interior.ColorIndex = 26 
 clr = clr + 10 
 
结束如果
下一个
 
 MsgBox（所有重复项发现和着色）
 
 End Sub 
  

解决方案

这是一个VBA尝试，同样的事情，我给了公式。我不认为这是必要的，但OP可能会从中学习。干杯！

  Sub ertdfgcvb（）
 Dim LastRow As Long，DatesCol As Long，AmountsCol As Long，as As Double ，b As Double 
 LastRow = Cells.Find（what：=*，SearchOrder = = xlByRows，Searchdirection = = xlPrevious）.Row 
 DatesCol = 4'D列，日期
 AmountsCol = 5'E列，金额为
列（DatesCol）.Interior.ColorIndex = xlNone'日期丢失颜色
对于i = 1对于每行$ To LastRow'
如果i& 1然后'有一些乐趣与行0错误
a = Application.WorksheetFunction.SumIfs（_ 
范围（单元格（1，DatesCol），单元格（i  -  1，DatesCol）），_ 
范围（单元格（1，DatesCol），单元格（i  -  1，DatesCol）），_ 
单元格（i，DatesCol），_ 
范围（单元格（1，AmountsCol） ，AmountsCol）），_ 
单元格（i，AmountsCol））'计算与
之间的复现相关联的日期值如果第一行我宣布为零，不知道为什么
结束If 
 
如果i& LastRow然后'是的，最后一行的东西
b = Application.WorksheetFunction.SumIfs（_ 
范围（单元格（i + 1，DatesCol），单元格（LastRow，DatesCol）），_ 
范围细胞（i + 1，DatesCol），细胞（LastRow，DatesCol）），_ 
细胞（i，DatesCol），_ 
范围（细胞（i + 1，AmountsCol），细胞（LastRow，AmountsCol ）），_ 
单元格（i，AmountsCol））'计算与
之后的复现相关联的日期值如果是最后一行，则
b = 0'，
结束如果
 
如果<> 0或b  - 0 Then Cells（i，4）.Interior.ColorIndex = 26'如果其中一个不是0，那么日期值将获得一个很好的背景颜色
 Next i 
 End Sub 
  

使用 Countifs 并进行一些优化，如下所示： / p>

  Sub ertdfgcvb（）
 Dim LastRow As Long，DatesCol As Long，AmountsCol As Long 
 LastRow = Cells .Find（什么：=*，SearchOrder：= xlByRows，Searchdirection = = xlPrevious）.Row 
 DatesCol = 4'D列，日期
 AmountsCol = 5'E列，金额
列（DatesCol）.Interior.ColorIndex = xlNone'日期丢失颜色
对于i = 1对于每一行$ LastRow'
如果1 < Application.WorksheetFunction.CountIfs（Range（Cells（1，DatesCol），Cells（LastRow，DatesCol）），_ 
单元格（i，DatesCol），_ 
范围（单元格（1，AmountsCol） （LastRow，AmountsCol）），_ 
单元格（i，AmountsCol））_ 
然后单元格（i，4）.Interior.ColorIndex = 26计数与事件相关联的日期值，如果超过一个日期得到一个很好的背景颜色
下一个我
结束Sub 
  

Is there a way in VBA to find duplicate entries when criteria in 2 columns meet?

I have two columns of data. First column has got dates and the second one amounts. The problem is to find and highlight all amounts that has got a duplicate amount and the same date in corresponding column?

I have so far managed to find a code to highlight duplicates on 1 criteria.

Here is the code

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

解决方案

This is a VBA attempt at the same thing I have given formula to. I don't think it was necessary but OP might learn from it anyways. Cheers!

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

With a Countifs and some optimisation it will look like this:

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

这篇关于当满足2个条件并标记它们时，查找重复的条目的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！