搜索匹配项：数组与个人

Question

这是有问题的代码：

Dim rr23WS As Worksheet, rrCell As Range
Dim rrCheck As Range
Dim r As Long
Dim rrMatch
Dim openWKBK as String

openWKBK = "X:\Resulting\Test.xlsx"
Workbooks.Open (openWKBK)
Set rr23WS = Workbooks("Test.xlsx").Sheets("January")
Set rrCheck = rr23WS.Columns(1)


For r = 1 To 4
                
    For Each rrCell In Worksheets("RACK " & r).Range("C6:N13").Cells
        
        rrCell.Borders.Color = RGB(0, 0, 0)
        rrCell.Borders.Weight = xlThin
        
        rrMatch = Application.Match(rrCell, rrCheck, 0)               'search Col A of Test.xlsx for matches
                
            If Not IsError(rrMatch) Then                 

                rrCell.Borders.Color = RGB(0, 0, 192)     'if match found, apply border to cell located in the range of ("C6:N13")
                rrCell.Borders.Weight = xlThick
                
            End If
    
    Next rrCell
    
Next r
End Sub

一切正常，但是，每次单击按钮时，它总是在 Test.xlsx 周内搜索 ~350-400 个匹配项，但 Test.xlsx 上的可搜索范围正在迅速扩大，我正在开始注意到宏稍微慢了一点（大约需要 10 秒，我知道这根本不是很长时间，我只是在考虑未来随着可搜索范围的不断增加）。

根据我对我的代码实际工作方式的理解，宏似乎不断地在 2 个工作簿之间来回跳转以寻找匹配项。如果那是正确的，那听起来效率很低。

我想知道将所有 4 个工作表的 ("C6:N13") 的整个范围设置为一个数组是否有意义，以便它可以一次搜索所有内容而不是在 2 个工作簿之间跳转。

根据我目前对 excel 如何执行逐步执行的理解，我认为这将有助于加快速度。

哪个是较小的邪恶：

正在大范围内搜索包含 ~400 个值的数组中的多个匹配项？
正在大范围内单独搜索约 400 个单元格的多个匹配项？

Answer 1

Match 对作品 sheet 通常非常快 - 更可能是单元格的格式设置很慢。在进入该范围的循环之前，您可以将 C6:N13 的单元格边框设置为黑色：无需单独设置每个单元格。

同样在一次操作中为任何给定 sheet 设置所有匹配的单元格，而不是单独设置

Sub lookitup()
    
    Const WB_PATH As String = "X:\Resulting\Test.xlsx" 'use constants for fixed values
    Const RNG_RACK As String = "C6:N13"
    
    Dim rr23WS As Worksheet, rrCell As Range, rngRack As Range
    Dim rrCheck As Range, rngMatched As Range
    Dim r As Long
    
    Set rr23WS = Workbooks.Open(WB_PATH).Sheets("January") 'get return value from Open()
    Set rrCheck = rr23WS.Columns(1)
    
    For r = 1 To 4
        'always qualify worksheets with a workbook object
        Set rngRack = ThisWorkbook.Worksheets("RACK " & r).Range(RNG_RACK)
        
        'reset to defaults...
        rngRack.Borders.Color = RGB(0, 0, 0)
        rngRack.Borders.Weight = xlThin
        
        Set rngMatched = Nothing
        For Each rrCell In rngRack.Cells
            If Not IsError(Application.Match(rrCell, rrCheck, 0)) Then
                'collect cell for later formatting
                If rngMatched Is Nothing Then
                    Set rngMatched = rrCell
                Else
                    Set rngMatched = Application.Union(rrCell, rngMatched)
                End If
            End If
        Next rrCell
        
        'format matched cells if any
        If Not rngMatched Is Nothing Then
            With rngMatched.Borders
                .Color = RGB(0, 0, 192)
                .Weight = xlThick
            End With
        End If
    Next r 'next sheet

    rr23WS.Parent.Close False 'close lookup workbook 

End Sub

搜索匹配项：数组与个人

Searching for matches: Array vs Individual

excel

vba

office365