如何使用For循环在三个不同的范围内提高VBA代码的效率?

时间:2018-12-23 04:56:44

标签: excel vba

基本上,我有这段代码可以找到三个范围和颜色的匹配项。它非常慢,我需要弄清楚如何使其更快。

这是代码

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

实际结果就是我想要的,但这太慢了,我需要帮助找到一种更有效的方法

1 个答案:

答案 0 :(得分:0)

由于您要检查WorkRng2WorkRng1中的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