如何让VBA循环运行更快？

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 & "]") 

由循环内的范围值。