Excel VBA跨工作表复制数据与更新图表脚本优化需求

现有VBA宏用于将"Chem Cost"的当前数据同步到"Daily Avgs (year)"的历史表，同时更新40个图表的X轴范围，但运行速度慢。以下是针对性的优化方案：

核心优化措施 #

1. 关闭屏幕刷新与事件触发 #

Excel默认每步操作后都会刷新界面、触发事件，这会大幅拖慢宏的运行速度。在宏开始时关闭这些功能，结束后恢复：

Application.ScreenUpdating = False
Application.EnableEvents = False
' 宏代码执行逻辑...
Application.ScreenUpdating = True
Application.EnableEvents = True

2. 抛弃Select/Selection，直接赋值 #

原代码用Copy+Select+PasteSpecial复制值，属于低效操作。直接将源单元格的值赋值给目标单元格，速度能提升数倍：

' 原低效代码
Sheets("Chem Cost").Range("ACPT").Copy
Sheets("Daily Avgs (year)").Cells(4, X).Select
Selection.PasteSpecial xlPasteValues

' 优化后代码
dailyAvgsSheet.Cells(4, X).Value = chemCostSheet.Range("ACPT").Value

3. 缓存工作表对象，减少重复查找 #

重复调用Sheets("xxx")会让Excel反复检索工作表，提前把常用工作表赋值给变量，直接调用变量即可：

Dim chemCostSheet As Worksheet
Dim dailyAvgsSheet As Worksheet
Set chemCostSheet = ThisWorkbook.Sheets("Chem Cost")
Set dailyAvgsSheet = ThisWorkbook.Sheets("Daily Avgs (year)")

4. 用Match替代Lookup，提升查找效率 #

原代码用Lookup获取列号，改用Match更直接高效，还能避免Lookup的潜在逻辑问题：

' 原代码
X = WorksheetFunction.Lookup(Range("Look_up_day"), dailyAvgsSheet.Rows("3:3"), dailyAvgsSheet.Rows("2:2"))

' 优化后
Dim lookUpVal As Variant
lookUpVal = chemCostSheet.Range("Look_up_day").Value
X = WorksheetFunction.Match(lookUpVal, dailyAvgsSheet.Rows("3:3"), 0)

5. 批量处理图表，消除冗余代码 #

原代码重复写40次图表X轴设置，用循环批量处理，既减少代码量，又减少重复访问Chart对象的开销：

' 定义需要更新的图表名称数组
Dim chartNames As Variant
chartNames = Array("Chart 11", "Chart 20", "Chart 21" ' ...补充剩余37个图表名称)

Dim minScale As Double, maxScale As Double
minScale = dailyAvgsSheet.Range("D1").Value
maxScale = dailyAvgsSheet.Range("G1").Value

Dim chartName As Variant
For Each chartName In chartNames
    With chemCostSheet.ChartObjects(chartName).Chart.Axes(xlCategory)
        .MinimumScale = minScale
        .MaximumScale = maxScale
    End With
Next

优化后的完整代码 #

Sub Daily()
    Dim chemCostSheet As Worksheet
    Dim dailyAvgsSheet As Worksheet
    Dim X As Integer
    Dim lookUpVal As Variant
    Dim chartNames As Variant
    Dim minScale As Double, maxScale As Double
    Dim chartName As Variant
    
    ' 关闭不必要的Excel功能，提速
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' 缓存工作表对象
    Set chemCostSheet = ThisWorkbook.Sheets("Chem Cost")
    Set dailyAvgsSheet = ThisWorkbook.Sheets("Daily Avgs (year)")
    
    ' 高效获取目标列号
    lookUpVal = chemCostSheet.Range("Look_up_day").Value
    X = WorksheetFunction.Match(lookUpVal, dailyAvgsSheet.Rows("3:3"), 0)
    
    ' 直接赋值同步数据，替代复制粘贴
    dailyAvgsSheet.Cells(4, X).Value = chemCostSheet.Range("ACPT").Value
    dailyAvgsSheet.Cells(18, X).Value = chemCostSheet.Range("Grade1").Value
    dailyAvgsSheet.Cells(30, X).Value = chemCostSheet.Range("Grade2").Value
    dailyAvgsSheet.Cells(42, X).Value = chemCostSheet.Range("Grade3").Value
    dailyAvgsSheet.Cells(91, X).Value = chemCostSheet.Range("ACPMSF").Value
    
    ' 批量更新图表X轴范围
    chartNames = Array("Chart 11", "Chart 20", "Chart 21" ' 补充剩余图表名称)
    minScale = dailyAvgsSheet.Range("D1").Value
    maxScale = dailyAvgsSheet.Range("G1").Value
    
    For Each chartName In chartNames
        With chemCostSheet.ChartObjects(chartName).Chart.Axes(xlCategory)
            .MinimumScale = minScale
            .MaximumScale = maxScale
        End With
    Next
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

内容的提问来源于stack exchange，提问作者Webster