Найти повторяющиеся записи, когда 2 критерия выполнены и отмечены ими

Question

Есть ли способ в VBA найти дубликаты записей, когда встречаются критерии в 2 столбцах?

У меня есть два столбца данных. Первая колонка имеет даты и вторая сумма. Проблема состоит в том, чтобы найти и выделить все суммы, которые получили дублирующее количество и ту же дату в соответствующей колонке?

Мне до сих пор удалось найти код для выделения дубликатов по 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)