本页定位

这一章面向可维护的 Excel 自动化工具。重点是性能、批量处理、模块化、错误处理和实战场景，而不是只会录制宏。

1. 性能优化

VBA 慢通常不是语言慢，而是频繁读写单元格、刷新屏幕和自动计算导致的。

常用优化开关：

Sub OptimizeStart()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
End Sub

Sub OptimizeEnd()
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

更安全的写法是使用错误处理确保开关能恢复。

Sub RunWithOptimization()
    On Error GoTo CleanFail

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

    ' 这里写主逻辑

CleanExit:
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Exit Sub

CleanFail:
    MsgBox "运行失败：" & Err.Description
    Resume CleanExit
End Sub

2. 使用数组加速

逐个单元格读写很慢，推荐一次读入数组、在内存中处理、一次写回。

Sub MarkOrdersByArray()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim data As Variant
    Dim i As Long

    Set ws = ThisWorkbook.Worksheets("Clean")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    data = ws.Range("A1:E" & lastRow).Value

    For i = 2 To UBound(data, 1)
        If data(i, 4) >= 1000 Then
            data(i, 5) = "高价值订单"
        Else
            data(i, 5) = "普通订单"
        End If
    Next i

    ws.Range("A1:E" & lastRow).Value = data
End Sub

3. 使用字典去重和聚合

字典适合做唯一值、分组汇总、快速查找。

Sub SumSalesByChannel()
    Dim dict As Object
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim key As String
    Dim amount As Double

    Set dict = CreateObject("Scripting.Dictionary")
    Set ws = ThisWorkbook.Worksheets("Clean")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    For i = 2 To lastRow
        key = ws.Cells(i, "C").Value
        amount = ws.Cells(i, "D").Value

        If dict.Exists(key) Then
            dict(key) = dict(key) + amount
        Else
            dict.Add key, amount
        End If
    Next i

    Worksheets("Calc").Range("A2").Resize(dict.Count, 1).Value = Application.Transpose(dict.Keys)
    Worksheets("Calc").Range("B2").Resize(dict.Count, 1).Value = Application.Transpose(dict.Items)
End Sub

4. 批量合并工作簿

典型场景：一个文件夹里有很多日报、月报，需要合并到一张明细表。

Sub MergeFilesInFolder()
    Dim folderPath As String
    Dim fileName As String
    Dim sourceWb As Workbook
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    Dim lastRow As Long
    Dim pasteRow As Long

    folderPath = "C:\Reports\"
    Set targetWs = ThisWorkbook.Worksheets("Raw")
    pasteRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row + 1

    fileName = Dir(folderPath & "*.xlsx")

    Do While fileName <> ""
        Set sourceWb = Workbooks.Open(folderPath & fileName)
        Set sourceWs = sourceWb.Worksheets(1)

        lastRow = sourceWs.Cells(sourceWs.Rows.Count, "A").End(xlUp).Row
        sourceWs.Range("A2:Z" & lastRow).Copy targetWs.Cells(pasteRow, "A")
        pasteRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row + 1

        sourceWb.Close SaveChanges:=False
        fileName = Dir
    Loop

    MsgBox "合并完成"
End Sub

5. 批量导出工作表

按区域或部门拆分文件：

Sub ExportSheetsToFiles()
    Dim ws As Worksheet
    Dim newWb As Workbook
    Dim savePath As String

    savePath = "C:\Exports\"

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Config" Then
            ws.Copy
            Set newWb = ActiveWorkbook
            newWb.SaveAs savePath & ws.Name & ".xlsx"
            newWb.Close SaveChanges:=False
        End If
    Next ws

    MsgBox "导出完成"
End Sub

6. 事件过程

事件过程可以在用户操作时自动触发。

工作簿打开时自动刷新

放在 ThisWorkbook 中：

Private Sub Workbook_Open()
    ThisWorkbook.RefreshAll
End Sub

单元格变化时自动记录时间

放在对应工作表代码区：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Me.Range("A:A")) Is Nothing Then Exit Sub

    Application.EnableEvents = False
    Target.Offset(0, 1).Value = Now
    Application.EnableEvents = True
End Sub

使用事件时一定要注意恢复 Application.EnableEvents，否则可能导致事件递归或失效。

7. 模块化设计

建议把代码拆成：

模块	职责
modMain	主流程入口
modImport	数据导入
modClean	数据清洗
modReport	报表刷新和导出
modUtils	通用工具函数

主流程示例：

Sub RunDailyReport()
    Call ImportRawData
    Call CleanOrderData
    Call RefreshReport
    Call ExportReport
    MsgBox "日报生成完成"
End Sub

8. 错误处理和日志

高阶 VBA 不能只靠弹窗，需要留下运行记录。

Sub WriteLog(message As String)
    Dim ws As Worksheet
    Dim nextRow As Long

    Set ws = ThisWorkbook.Worksheets("Log")
    nextRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1

    ws.Cells(nextRow, "A").Value = Now
    ws.Cells(nextRow, "B").Value = message
End Sub

调用：

Call WriteLog("开始导入数据")
Call WriteLog("导入完成")

9. 高阶代码原则

• 先保证准确，再优化速度。
• 先写清流程，再抽象函数。
• 大批量数据优先使用数组。
• 查找和聚合优先使用字典。
• 所有自动化都要有错误处理和恢复逻辑。
• 交付给他人使用时，要有按钮、说明和运行提示。

贡献者: kai

上一页VBA 代码基础

下一页Power BI