VBA代码运行过慢原因排查？是否因循环过多导致？

嘿Julia！先给你点个大大的赞——能写出支持多文件选择、按工作表名匹配追加数据，还自动添加日期和位置标识列的VBA代码，这已经相当厉害了！运行速度慢确实是VBA处理批量数据时的常见痛点，我给你分享几个亲测有效的优化技巧，应该能让你的代码飞起来：

1. 先关掉Excel的“多余动作” #

Excel默认每一步操作都会刷新屏幕、触发事件、自动计算，这些都会拖慢代码运行速度。建议在代码开头先把这些功能暂时关闭，处理完所有数据后再恢复：

' 开头关闭不必要的功能
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

一定要记得在代码结束（包括错误处理分支里）恢复这些设置，不然会影响后续的Excel操作：

' 结尾恢复设置
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

2. 用数组替代逐行写入（最关键的提速点！） #

逐行往工作表单元格写数据是速度杀手，效率极低。建议把源数据一次性读到内存数组里，在数组里完成添加日期、位置列的操作，最后再一次性写入目标工作表，速度能提升几十甚至上百倍：
举个简化的实现示例：

' 读取源工作表的有效数据到数组
Dim sourceArr As Variant
Dim sourceWs As Worksheet
Set sourceWs = wbSource.Worksheets("匹配到的工作表名")
Dim lastRow As Long, lastCol As Long
lastRow = sourceWs.Cells(sourceWs.Rows.Count, 1).End(xlUp).Row
lastCol = sourceWs.Cells(1, sourceWs.Columns.Count).End(xlToLeft).Column
sourceArr = sourceWs.Range(sourceWs.Cells(1, 1), sourceWs.Cells(lastRow, lastCol)).Value

' 创建新数组，预留日期和位置列的空间
Dim targetArr As Variant
ReDim targetArr(1 To UBound(sourceArr, 1), 1 To UBound(sourceArr, 2) + 2)

' 复制原数据并添加标识列
Dim i As Long, j As Long
For i = 1 To UBound(sourceArr, 1)
    ' 复制原数据列
    For j = 1 To UBound(sourceArr, 2)
        targetArr(i, j) = sourceArr(i, j)
    Next j
    ' 添加日期列（这里可以替换成你需要的具体日期，比如文件创建日期）
    targetArr(i, UBound(sourceArr, 2) + 1) = Date
    ' 添加位置标识符（比如源文件名或者自定义标识）
    targetArr(i, UBound(sourceArr, 2) + 2) = wbSource.Name
Next i

' 一次性写入目标工作表
Dim targetWs As Worksheet
Set targetWs = ThisWorkbook.Worksheets("匹配到的目标工作表名")
Dim targetLastRow As Long
targetLastRow = targetWs.Cells(targetWs.Rows.Count, 1).End(xlUp).Row + 1
targetWs.Cells(targetLastRow, 1).Resize(UBound(targetArr, 1), UBound(targetArr, 2)).Value = targetArr

3. 避免不必要的激活/选择操作 #

很多新手写VBA习惯用Activate或者Select来切换工作表/工作簿，但这些操作不仅慢，还容易出错。直接用对象变量引用工作表和工作簿就好，比如：

' 不要这么写：
Workbooks("源文件.xlsx").Activate
Sheets("Sheet1").Select
Range("A1").Copy

' 改成这样：
Dim wbSource As Workbook
Set wbSource = Workbooks.Open("你的文件路径")
Dim wsSource As Worksheet
Set wsSource = wbSource.Worksheets("Sheet1")
' 直接操作wsSource，不用激活

4. 精确获取数据范围，避免读取无效空白区域 #

UsedRange有时候会包含一些看似空白但实际有格式的单元格，导致读取的数据量变大。用End(xlUp)和End(xlToLeft)来获取精确的最后一行和最后一列，能减少数组的大小，提升效率，就像上面示例里的那样。

如果你的代码还有其他特殊逻辑，或者优化后还是有问题，可以把具体的代码片段贴出来，我再帮你细化调整！

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