如何提高VBA Do While循环效率？

Question

我正在尝试处理 Excel 工作表中包含大约 50k 行的列。该列包含需要评估的文本值，如果匹配正确，则需要提取该字符串的一部分。下面的代码适用于 3000 行，但超出此范围就不起作用。

有人可以建议此代码的替代方案吗？

`Function getManagerRating(EmpID As String)  
row_number = 2  
Application.ScreenUpdating = False  
Application.Calculation = xlCalculationManual  
Application.EnableEvents = False  
Do While row_number < 4000  
     cellValue = Sheets("Master").Range("AA" & row_number)  
     ID = Left$(cellValue, 8)  
     If ID = EmpID Then  
         If InStr(cellValue, "Overall Rating By Manager") > 0 Then  
         Position = Len(cellValue) - InStr(cellValue, "@")  
         reqValue = Right$(cellValue, Position)  
         End If  
     End If  
 row_number = row_number + 1  
Loop  

Application.ScreenUpdating = True  
Application.Calculation = xlCalculationAutomatic  
Application.EnableEvents = True  
getManagerRating = reqValue  
End Function  `

Answer 1

我的建议是这样调整代码

Function getManagerRating(EmpID As String)
    Dim row_number As Long
    ' Adjust If you've got more rows
    ' or determine the number of filled rows
    row_number = 50000
    
    ' reading all cells into an arry
    ' it will be a 2D array
    Dim vdat As Variant
    vdat = Sheets("Master").Range("AA1:AA" & row_number)
    
       
    ' Declare all variable. That is good practise
    Dim i As Long, cellValue As Variant, ID As String, Position As Long, reqValue As String
    
    'Instead of a do loop one can use a for loop
    ' using the lower and upper bound of the array
    For i = LBound(vdat) To UBound(vdat)
        'cellValue = Sheets("Master").Range("AA" & row_number)
        cellValue = vdat(i, 1)
        ID = Left$(cellValue, 8)
        If ID = EmpID Then
            If InStr(cellValue, "Overall Rating By Manager") > 0 Then
                Position = Len(cellValue) - InStr(cellValue, "@")
                reqValue = Right$(cellValue, Position)
                ' ?? It seems that EmpID is unique
                ' i.e. you can leave the loop here
                Exit For
            End If
        End If
    Next i

    getManagerRating = reqValue
End Function