如何避免使用选择/激活

问题描述

如何避免在我的宏中使用选择/激活（以帮助加快速度）？

宏遍历工作表上的每一行；如果数量大于零（在 C 列中），则它调用另一个宏来打开一个特定的工作簿（在 A 列中的工作簿名称），进行一些更改，然后关闭该工作簿。

Sub Update_All_Workbooks()
    
    Dim LastRow As Long
    Dim Datarange As Range
    Dim WB As Workbook
    Dim WS As Worksheet
    
    Set WB = ActiveWorkbook
    Set WS = ActiveSheet
    
    LastRow = Cells(Rows.Count,"A").End(xlUp).Row
    
    Set Datarange = Sheets("TestA").Range("A3:A" & LastRow)
    
    Application.ScreenUpdating = False
    Application.displayAlerts = False
    
    WB.Sheets("TestA").Activate
    Range("C3").Select
    
    For Each Row In Datarange
        If ActiveCell > 0 Then
            Call Open_Update_Close_WB
            WB.Sheets("TestA").Activate
            ActiveCell.Offset(1,0).Select
        Else
            ActiveCell.Offset(1,0).Select
        End If
    Next Row
        
    WS.Activate
        
End Sub

解决方法

从使用 select 到使用引用的观点发生了很大变化，但从长远来看，使用引用时代码会更好。

我希望下面的代码对你有用。

Option Explicit

Sub Update_All_Workbooks()
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Dim myWB As Workbook
    Set myWB = ActiveWorkbook
    
    ' We set myWS on the basis of the unqualified Cell method used in th original code
    Dim myWS As Worksheet
    Set myWS = myWB.ActiveSheet
    
    Dim LastRow As Long
    LastRow = myWS.Cells(Rows.Count,"A").End(xlUp).Row
    
    ' Pull the filenames into a VBA array
    ' So we don't keep having to refder to a Worksheet
    ' The transpose method is used to convert the pseudo 2D array
    ' to a correct 1D array
    Dim myWbNames As Variant
    Set myWbNames = myWB.Application.WorksheetFunction.Transpose(myWS.Range("A3:A" & LastRow).Value)
    
    
    ' Similar to above,you can extract the QTY values in
    ' column C to a VBA array
    Dim myQTY As Variant
    Set myQTY = myWB.Application.WorksheetFunction.Transpose(myWS.Range("C3:C" & LastRow).Value)
    
    ' Because we are processing two arrays (col a and col c)
    ' its easier to use a standard for loop with an index than a for each loop
    Dim myIndex As Variant
    For myIndex = LBound(myWbNames) To UBound(myWbNames)
        If myQTY(myIndex) > 0 Then
        
            Open_Update_Close_WB myWbNames(myIndex)
            
        End If
        
    Next
        
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
        
End Sub

' Underscores have significance in Method names as they are used in
' interface and event declarations
' Therefore it is good practise to get used to NOT using underscores
' for Method names that do not involve an interface

Public Sub OpenUpdateCloseWB(ByVal ipWbName As String)

End Sub