求助：如何提升功能正常但执行缓慢的VBA代码运行速度

嘿，刚接触VBA就遇到运行速度的问题太正常了——Excel默认的很多行为都会拖慢代码执行，尤其是涉及表格和图表操作的时候。我给你几个针对性的提速技巧，都是日常调代码时最常用的，应该能帮你解决问题：

• 先关掉Excel的“自动操作”开关
  每次单元格变化、格式调整，Excel都会自动刷新屏幕、触发事件、重新计算公式，这些后台操作是拖慢速度的重灾区。在代码开头加上这几行，结尾再恢复：

  ' 开头禁用
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  
  ' 结尾恢复
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  

  这一步几乎能让代码速度提升好几倍，是新手最容易忽略的关键点。

• 别逐单元格操作，用数组批量读写
  如果你现在是循环每个单元格复制数据，赶紧改成用数组一次性读取源数据，再一次性写入目标表格。比如：

  ' 一次性把源数据读到数组里
  Dim sourceData As Variant
  sourceData = ThisWorkbook.Sheets("源表").Range("A2:C1000").Value
  
  ' 一次性把数组写入目标表格
  Dim targetTbl As ListObject
  Set targetTbl = ThisWorkbook.Sheets("目标表").ListObjects("表格1")
  
  ' 先清空表格现有数据（如果有）
  If Not targetTbl.DataBodyRange Is Nothing Then
      targetTbl.DataBodyRange.Delete
  End If
  ' 添加对应行数，再批量赋值
  targetTbl.ListRows.Add Count:=UBound(sourceData)
  targetTbl.DataBodyRange.Value = sourceData
  

  数组操作比逐单元格循环快几十倍，数据量越大效果越明显。

• 操作表格（ListObject）时的小细节
  你用的是转换为区域的表格，更新时别频繁插入单行或逐个设置格式：

  • 清空数据时直接删除整个DataBodyRange，而不是逐行删除；
  • 格式化时整列设置，比如targetTbl.ListColumns("数值列").DataBodyRange.NumberFormat = "#,##0"，不要给每个单元格单独设格式；
  • 避免用Select/Activate切换表格或单元格，直接用对象引用操作（比如上面代码里的targetTbl变量）。

• 优化图表更新
  默认情况下，表格数据变化时图表会自动刷新，两次表格更新就会触发两次图表刷新。可以先关闭图表的自动更新，等所有数据操作完成后再手动刷新：

  ' 先关闭自动更新（如果需要）
  ThisWorkbook.Sheets("目标表").ChartObjects("图表1").Chart.ChartData.AutoUpdate = False
  ThisWorkbook.Sheets("目标表").ChartObjects("图表2").Chart.ChartData.AutoUpdate = False
  
  ' 数据和格式都弄完后，手动刷新一次
  ThisWorkbook.Sheets("目标表").ChartObjects("图表1").Chart.Refresh
  ThisWorkbook.Sheets("目标表").ChartObjects("图表2").Chart.Refresh
  

• 减少工作表切换
  把常用的工作表和表格对象赋值给变量，比如：

  Dim wsSource As Worksheet, wsTarget As Worksheet
  Set wsSource = ThisWorkbook.Sheets("源数据")
  Set wsTarget = ThisWorkbook.Sheets图表数据")
  

  之后直接用变量操作，不用每次都写Sheets("XXX")，减少Excel查找工作表的时间。

把上面的技巧结合起来，大概是这样的结构，你可以根据自己的实际数据调整：

Sub 快速更新表格与图表()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim tbl1 As ListObject, tbl2 As ListObject
    Dim dataForTbl1 As Variant, dataForTbl2 As Variant
    
    ' 禁用Excel后台操作
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' 赋值对象变量
    Set wsSource = ThisWorkbook.Sheets("你的源工作表名")
    Set wsTarget = ThisWorkbook.Sheets("你的目标工作表名")
    Set tbl1 = wsTarget.ListObjects("表格1的名称")
    Set tbl2 = wsTarget.ListObjects("表格2的名称")
    
    ' 读取源数据到数组
    dataForTbl1 = wsSource.Range("A2:B500").Value ' 替换成你实际的源数据区域
    dataForTbl2 = wsSource.Range("D2:E500").Value
    
    ' 清空表格现有数据
    If Not tbl1.DataBodyRange Is Nothing Then tbl1.DataBodyRange.Delete
    If Not tbl2.DataBodyRange Is Nothing Then tbl2.DataBodyRange.Delete
    
    ' 批量写入表格1并设置格式
    If UBound(dataForTbl1) > 0 Then
        tbl1.ListRows.Add Count:=UBound(dataForTbl1)
        tbl1.DataBodyRange.Value = dataForTbl1
        tbl1.ListColumns("数值列").DataBodyRange.NumberFormat = "#,##0"
    End If
    
    ' 批量写入表格2并设置格式
    If UBound(dataForTbl2) > 0 Then
        tbl2.ListRows.Add Count:=UBound(dataForTbl2)
        tbl2.DataBodyRange.Value = dataForTbl2
        tbl2.ListColumns("百分比列").DataBodyRange.NumberFormat = "0.0%"
    End If
    
    ' 手动刷新图表
    wsTarget.ChartObjects("图表1").Chart.Refresh
    wsTarget.ChartObjects("图表2").Chart.Refresh
    
    ' 恢复Excel功能
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "更新完成！"
End Sub

这些技巧应该能帮你把代码速度提上去，要是还有问题，可以把你的具体代码片段贴出来，我再帮你针对性调整～

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