改用Cells(x,y)替代Offset后VBA代码性能暴跌100倍，如何优化？

你的代码思路本身没问题——用结构化引用获取列号替代Offset，确实能提升代码在列插入/移动时的鲁棒性，不属于不良实践。但循环运行速度暴跌100倍的核心原因是：在循环内部重复调用Range("Table[Column]").Column，每次都要让Excel重新解析表结构，频繁交互对象模型带来了巨大的性能开销。

以下是具体的优化步骤，按效果优先级排序：

1. 提前缓存列号（最基础且立竿见影） #

把需要用到的列号在循环外部提前获取并存储为变量，循环内部直接使用变量，避免重复查询表结构：

' 循环执行前，一次性获取并缓存列号
Dim scheduleNameCol As Long
scheduleNameCol = Schedule.Range("Schedule[Name]").Column

Dim infoNameCol As Long
infoNameCol = Info.Range("Info[Name]").Column

' 循环内部直接用缓存的变量
Set employee = Info.Range("Info[Payroll]").Find(cell)
If Not employee Is Nothing Then ' 增加非空判断，避免Find失败报错
    Schedule.Cells(x, scheduleNameCol) = Info.Cells(employee.Row, infoNameCol)
End If

2. 关闭Excel的UI与计算开销 #

循环执行前关闭屏幕刷新、事件触发和自动计算，减少Excel的后台操作，循环结束后恢复默认设置：

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

' --- 你的循环代码放在这里 ---

' 循环结束后恢复默认设置
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True

3. 用字典缓存查找映射（替代循环内Find） #

每次调用Range.Find都会遍历单元格，400次循环就会执行400次查找，效率极低。可以提前把Info表的Payroll和对应Name值存入字典，循环时直接通过键取值：

Dim payrollMap As Object
Set payrollMap = CreateObject("Scripting.Dictionary")

' 提前把Info表的Payroll-Name映射存入字典
Dim infoRow As ListRow
For Each infoRow In Info.ListObject.ListRows
    Dim payrollKey As Variant
    payrollKey = infoRow.Range(Info.Range("Info[Payroll]").Column - Info.ListObject.Range.Column + 1).Value
    Dim nameVal As Variant
    nameVal = infoRow.Range(infoNameCol - Info.ListObject.Range.Column + 1).Value ' 复用之前缓存的infoNameCol
    
    ' 避免重复键（若有重复Payroll可根据需求调整逻辑）
    If Not payrollMap.Exists(payrollKey) Then
        payrollMap.Add payrollKey, nameVal
    End If
Next infoRow

' 循环处理Schedule表，直接从字典取值
Dim scheduleRow As ListRow
For Each scheduleRow In Schedule.ListObject.ListRows
    Dim currentPayroll As Variant
    currentPayroll = scheduleRow.Range(Schedule.Range("Schedule[Payroll]").Column - Schedule.ListObject.Range.Column + 1).Value
    
    If payrollMap.Exists(currentPayroll) Then
        scheduleRow.Range(scheduleNameCol - Schedule.ListObject.Range.Column + 1).Value = payrollMap(currentPayroll)
    End If
Next scheduleRow

4. 批量读写数组（极致性能优化） #

如果数据量更大，把整个表的数据读到内存数组中处理，再一次性写回工作表——数组操作在内存中完成，比反复读写单元格快几个数量级：

' 读取Info表的Payroll和Name列到数组
Dim infoArr As Variant
infoArr = Info.Range("Info[Payroll]:Info[Name]").Value

' 读取Schedule表的Payroll和目标Name列到数组
Dim scheduleArr As Variant
scheduleArr = Schedule.Range("Schedule[Payroll]:Schedule[Name]").Value

' 循环处理数组
Dim i As Long, j As Long
For i = 1 To UBound(scheduleArr, 1)
    For j = 1 To UBound(infoArr, 1)
        If scheduleArr(i, 1) = infoArr(j, 1) Then
            scheduleArr(i, 2) = infoArr(j, 2)
            Exit For ' 找到匹配后退出内层循环
        End If
    Next j
Next i

' 把处理后的数组写回Schedule表
Schedule.Range("Schedule[Payroll]:Schedule[Name]").Value = scheduleArr

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