Question

为Excel编写的此循环获取2个唯一列表的范围，并在不同工作表的表中搜索它们。它是一个两列搜索，列表中的2个值必须出现在一行中，以便累加器计数。它运行得很好，但是当我解析大量数据时，我可以等待几分钟。我正在寻找一种方法来使这个循环更快。任何帮助，将不胜感激。提前谢谢。

Sub parseTwo(ByVal startRng As Range, ByVal findRng As Range, _
ByVal pasteStartRng As Range, ByVal strTitle As String, ByVal findTableColumn As String, _
ByVal startOffset As Integer, ByVal handledOffset As Integer, _
ByVal handledBool As Boolean)
'==========================================================================
'==========================================================================
'Turn off some Excel functionality so code runs faster
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'==========================================================================
'==========================================================================
Dim x As Long           'Declare accumulator.
x = 0                   'Give x default value.
'==========================================================================
'==========================================================================
Dim firstLoop As Boolean 'Declare boolean value.
firstLoop = True         'Declare initial value of boolean as true.
'==========================================================================
'==========================================================================
Dim pasteFindRng As Range 'Set the paste range for "find" items.
Set pasteFindRng = pasteStartRng.Offset(1, -1
Dim pasteAccum As Range   'Set the paste range for the "accumulator".
Set pasteAccum = pasteStartRng.Offset(1, 0)
'==========================================================================
'==========================================================================
Dim initialFindRng As Range 'Keep track of the initial "find" range to reference it later.
Set initialFindRng = findRng
'==========================================================================
'==========================================================================
Do While startRng.Text <> vbNullString             'Do while there is data in the "start" range.
    Do While findRng.Text <> vbNullString          'Do while there is data in the "find" range.
        With Worksheets("Formatting").Range("FormattingTable[" & findTableColumn & "]")
            Set c = .Find(findRng.Text, LookIn:=xlValues, LookAt:=xlWhole)
                    firstAddress = c.Address
                    Do
                        If handledBool = True Then
                            If c.Offset(0, handledOffset).Text <> vbNullString Then
                                If c.Offset(0, startOffset).Text = startRng.Text Then
                                    x = x + 1
                                End If
                            End If
                        Else
                            If c.Offset(0, startOffset).Text = startRng.Text Then
                                x = x + 1
                            End If
                        End If
                    Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> firstAddress
        End With
'==========================================================================
'==========================================================================
        If firstLoop = True Then   'If this is the first time through loop then paste find items
            pasteFindRng.Value = findRng.Text
            Set pasteFindRng = pasteFindRng.Offset(1, 0) 'Set pastefind range down 1
        End If
'==========================================================================
        pasteAccum.Value = x                  'Set x to paste.
        Set pasteAccum = pasteAccum.Offset(1, 0)    'Set accumulator paste range down 1.
        x = 0                                       'Reset x
'==========================================================================
        Set findRng = findRng.Offset(1, 0)          'Set find range down 1.
'==========================================================================
    Loop
    If firstLoop = True Then 'If this is the first time through loop then paste the title.
        pasteStartRng.Offset(0, -1) = strTitle
    End I
'==========================================================================
    pasteStartRng.Value = startRng.Text             'Paste the value of the start range.
'==========================================================================
    Set pasteStartRng = pasteStartRng.Offset(0, 1)   'Set paste start range over to the right 1.
'==========================================================================
    Set pasteAccum = pasteStartRng.Offset(1, 0)     'Reset "accumulator" paste range.
'==========================================================================
    Set startRng = startRng.Offset(1, 0)            'Move "start" range down 1.
    Set findRng = initialFindRng                    'Reset "find" range.
'==========================================================================
    firstLoop = False
Loop
'========================================================================================
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub

Answer 1

作为提示，尝试使用

创建变量

Range("FormattingTable[" & findTableColumn & "]")

值并避免在循环内执行此操作。或者更好的替换：

Worksheets("Formatting").Range("FormattingTable[" & findTableColumn & "]")

通过循环内的范围值。

如何让这个VBA循环运行得更快？

1 个答案: