Выделите дубликаты клеток в два столбца

Question

Я пытаюсь сравнить два столбца и выделить текст, который был найден в обоих столбцах просто, и если столбец A содержит какое-либо число более одного раза, выделенное только одно и то же число в столбце b для примера. столбец A содержит 13, 13,13, а столбец B содержит только 13 раз, выделите SO, только 13 раз в столбце A и 13 раз в b, вы можете увидеть прикрепленный pi c для большего понимания, большое спасибо в продвинутом

Sub Duplicate()
Dim myRange As Range
Dim i As Integer
Dim j As Integer
Dim myCell As Range
Set myRange = Range("A1:B100")
For Each myCell In myRange
If WorksheetFunction.CountIf(myRange, myCell.Value) > 1 Then
myCell.Interior.ColorIndex = 3
End If
Next
End Sub

Answer 1

Я думаю, что, может быть, в вашем примере есть пара ошибок (12)?

Я уверен, что вы можете сделать это с CF, но я не могу потрудиться, чтобы попытаться это решить.

Sub Duplicate()

Dim myRange As Range
Dim count1 As Long, count2 As Long, i As Long
Dim myCell As Range
Dim rFind1 As Range, rFind2 As Range

Set myRange = Range("A1:B11")

For Each myCell In myRange.Columns(1).Cells                              'loop through each cell in column A
    count1 = WorksheetFunction.CountIf(myRange.Columns(1), myCell.Value) 'number of times found in A
    count2 = WorksheetFunction.CountIf(myRange.Columns(2), myCell.Value) 'number of times found in B
    If count2 > 0 Then                                                   'only do something if found in B
        Set rFind1 = myRange.Cells(myRange.Rows.count, 1)                'initialize Find at last cell of A
        Set rFind2 = myRange.Cells(myRange.Rows.count, 2)                'initialize Find at last cell of B
        For i = 1 To WorksheetFunction.Min(count1, count2)               'loop number of times found (lower of the 2 values)
            With myRange
                Set rFind1 = .Columns(1).Find(What:=myCell.Value, After:=rFind1, Lookat:=xlWhole, SearchOrder:=xlByRows, _
                                              SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) 'find the cell
                Set rFind2 = .Columns(2).Find(What:=myCell.Value, After:=rFind2)                              'find the matching cell in B
                rFind1.Interior.ColorIndex = 3                           'shade A
                rFind2.Interior.ColorIndex = 3                           'shade B
            End With
        Next i
    End If
Next myCell

End Sub