Мне нужен код VBA, который будет сравнивать 2 листа и найти строки с несколькими одинаковыми значениями ячеек и выделить эти ячейки

Question

Мне нужно сравнить данные между двумя рабочими листами Excel и найти строки, которые имеют одинаковые значения.У меня есть несколько значений в одной строке, и эти значения соответствуют значениям из другой строки на другом листе.Я хотел бы, чтобы эти значения были выделены.

Я пробовал код, который работает, когда я использую его для небольших данных, например, 10 строк на каждом листе.Но когда я использую его для большего количества данных, Excel просто не отвечает и не работает даже после долгого ожидания. После нескольких исследований я обнаружил, что накладные расходы между vba и excel вызывают долгое ожидание инеотзывчивое поведение.Пожалуйста, предоставьте мне код, который будет работать аналогично этому, но в скором времени.

Sub CompareRanges()
'Update 20130815
Dim WorkRng1 As Range, WorkRng2 As Range, Rng1 As Range, Rng2 As Range
xTitleId = "KutoolsforExcel"
Set WorkRng1 = Application.InputBox("Range A:", xTitleId, "", Type:=8)
Set WorkRng2 = Application.InputBox("Range B:", xTitleId, Type:=8)
For Each Rng1 In WorkRng1
    rng1Value = Rng1.Value
    For Each Rng2 In WorkRng2
        If rng1Value = Rng2.Value Then
            Rng1.Interior.Color = VBA.RGB(0, 255, 0)
            Rng2.Interior.Color = VBA.RGB(0, 255, 0)
            Exit For
        End If
    Next
Next
End Sub

Answer 1

Добавление DoEvents в ваши циклы должно решить проблему "Excel не отвечает".

Sub CompareRanges()
'Update 20130815
Dim WorkRng1 As Range, WorkRng2 As Range, Rng1 As Range, Rng2 As Range
xTitleId = "KutoolsforExcel"
Set WorkRng1 = Application.InputBox("Range A:", xTitleId, "", Type:=8)
Set WorkRng2 = Application.InputBox("Range B:", xTitleId, Type:=8)
For Each Rng1 In WorkRng1
    DoEvents
    rng1Value = Rng1.Value
    For Each Rng2 In WorkRng2
        DoEvents
        If rng1Value = Rng2.Value Then
            Rng1.Interior.Color = VBA.RGB(0, 255, 0)
            Rng2.Interior.Color = VBA.RGB(0, 255, 0)
            Exit For
        End If
    Next
Next
End Sub