Как сделать мой код VBA более эффективным, используя цикл «Для каждого» для трех разных диапазонов?

Question

В основном у меня есть этот код, который находит совпадения по трем диапазонам и цветам соответственно.Это очень медленно, и мне нужно выяснить, как сделать это быстрее.

Вот код

Private Sub Search_Find_Match_Click()
    Dim WorkRng1 As Range, WorkRng2 As Range, WorkRng3 As Range, _
    Rng1 As Range, Rng2 As Range, Rng3 As Range

    xTitleId = "KutoolsforExcel"

    Set WorkRng1 = Application.InputBox("Range For List:", xTitleId, "A2:A1254", Type:=8)
    Set WorkRng2 = Application.InputBox("Range For Floorscan:", xTitleId, Type:=8)
    Set WorkRng3 = Application.InputBox("Range For RSVP:", xTitleId, Type:=8)

    For Each Rng1 In WorkRng1
        rng1Value = Rng1.Value * 1
        For Each Rng2 In WorkRng2
            If Not IsEmpty(Rng2.Value) And Rng2.Value <> "" Then
                Rng2.Value = Rng2.Value * 1
            End If
            If rng1Value = Rng2.Value Then
                Rng2.EntireRow.Interior.Color = VBA.RGB(125, 244, 66)
            End If
            For Each Rng3 In WorkRng3
                If Not IsEmpty(Rng3.Value) And Rng3.Value <> "" Then
                    rng3Value = Rng3.Value * 1
                End If
                If rng3Value = Rng2.Value Then
                    Rng2.EntireRow.Interior.Color = VBA.RGB(247, 113, 113)
                    Exit For
                End If
            Next
        Next
    Next
End Sub

Фактические результаты - это то, что я хочу, но они очень медленные, и мне нужна помощь в поиске более эффективного способа сделать это

Answer 1

, поскольку вы проверяете совпадения значений диапазона WorkRng2 в WorkRng1 и WorkRng3, вы можете циклически проходить только по WorkRng2 ячейкам

и использовать Find() метод RangeОбъект для поиска любого возможного совпадения:

Dim WorkRng1 As Range, WorkRng2 As Range, WorkRng3 As Range, Rng2 As Range
Dim xTitleId As String

xTitleId = "KutoolsforExcel"

Set WorkRng1 = Application.InputBox("Range For List:", xTitleId, "A2:A1254", Type:=8)
Set WorkRng2 = Application.InputBox("Range For Floorscan:", xTitleId, Type:=8)
Set WorkRng3 = Application.InputBox("Range For RSVP:", xTitleId, Type:=8)


For Each Rng2 In WorkRng2
    If Not WorkRng1.Find(what:=Rng2.Value, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then Rng2.EntireRow.Interior.Color = VBA.RGB(125, 244, 66)
    If Not WorkRng3.Find(what:=Rng2.Value, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then Rng2.EntireRow.Interior.Color = VBA.RGB(247, 113, 113)
Next