Excel VBA写入100个单元格耗时5秒，求高效优化方案

你的代码主要耗时在遍历查找行和逐个单元格赋值这两个环节，下面是具体的优化方案：

1. 用Match函数替代循环查找ID #

遍历整行查找的效率会随表格行数增加急剧下降，用Excel内置的Match函数可以直接定位ID所在行，速度快得多：

Dim rowIndex As Variant
' 在表格的ID列中查找searchID
rowIndex = Application.WorksheetFunction.Match(searchID, tbl.ListColumns(idColumnIndex).DataBodyRange, 0)

' 处理ID不存在的情况
If IsError(rowIndex) Then
    MsgBox "未找到对应ID的数据"
    Exit Sub
End If

2. 批量赋值替代逐个单元格写入 #

每次单独给单元格赋值都会触发Excel的交互操作，100次就是100次交互，换成数组批量操作能大幅减少耗时：

情况1：目标单元格是连续区域 #

如果目标是连续的单元格区域（比如从E12到E111），可以直接把整行数据一次性写入：

' 将找到的行数据存入数组
Dim sourceData As Variant
sourceData = tbl.DataBodyRange(rowIndex, 1).Resize(1, tbl.ListColumns.Count).Value

' 一次性写入目标区域（假设目标是masterSht的E12开始的连续100个单元格）
masterSht.Range("E12").Resize(1, 100).Value = sourceData

情况2：目标单元格是分散的 #

如果目标单元格是不连续的（比如E12、G15、H20这类），可以先把目标区域的对应位置用数组批量映射赋值：

' 定义目标单元格地址数组（补充你的100个单元格地址）
Dim targetRanges As Variant
targetRanges = Array("E12", "G15", "H20", ...)

' 读取源行数据到数组
Dim sourceArr As Variant
sourceArr = tbl.DataBodyRange(rowIndex).Value

' 批量写入目标单元格（根据实际需求调整源列与目标单元格的对应关系）
For i = 0 To UBound(targetRanges)
    masterSht.Range(targetRanges(i)).Value = sourceArr(1, i + 1)
Next i

3. 开启VBA性能优化开关 #

在代码执行前后添加以下设置，减少Excel的屏幕刷新、事件触发和自动计算，进一步提升速度：

' 执行前关闭不必要的功能
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

' 这里放你的核心代码（查找+赋值）

' 执行后恢复设置
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True

把这三点结合起来，你的代码执行时间应该能从5秒降到几百毫秒甚至更短。

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