VBA Excel表头与A列值拼接实现：循环优化及公式报错解决

原循环性能差的核心原因 #

• 逐单元格直接读写工作表，每次操作都会触发Excel的内存交互、界面重绘，数据量越大IO开销呈指数级上升
• 循环前未关闭屏幕更新、自动计算等非必要后台流程，额外放大了运行耗时

批量公式实现错误的原因 #

• 仅给B列写入了公式，没有覆盖从B列到最后一个有效表头的所有目标列，其余列没有生成对应拼接结果
• 公式引用未做必要的绝对/相对锁定：横向填充时需要固定引用当前列的第1行表头、固定引用A列的当前行值，否则会出现引用偏移，导致拼接内容错列

方案1：修正版批量公式填充（适合常规数据量） #

完全无需逐格循环，通过统一公式规则一次性生成全区域拼接结果，运行速度是原循环的上百倍。
核心逻辑是给整个目标输出区域统一写入符合引用规则的公式，Excel会自动对相对引用做适配：

• 表头部分用列相对、行绝对引用（如B$1），横向填充时自动匹配当前列表头，行号永远锁定第1行
• A列值部分用列绝对、行相对引用（如$A2），纵向填充时自动匹配当前行A列的值，列标永远锁定A列

完整代码：

Sub 批量公式拼接优化()
    Dim lngLastRow As Long, lngLastCol As Long
    ' 关闭非必要性能开销
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' 定位有效数据边界
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row ' A列最后有效行
    lngLastCol = Cells(1, Columns.Count).End(xlToLeft).Column ' 第1行最后有效表头列
    
    ' 给全目标区域写入统一规则的公式
    Range(Cells(2, "B"), Cells(lngLastRow, lngLastCol)).Formula = "=B$1 & ""_"" & $A2"
    
    ' 恢复初始环境设置
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

提示：如果不需要下划线作为拼接分隔符，可将公式中的"_"替换为空字符串，即可和原循环的无分隔符拼接效果完全一致。

方案2：内存数组拼接（适合十万行以上大数据量） #

完全绕开工作表交互流程，把所有需要的数据一次性读入内存完成拼接，再一次性写回工作表，运行速度比逐格循环快上千倍。
完整代码：

Sub 内存数组拼接优化()
    Dim lngLastRow As Long, lngLastCol As Long
    Dim arrHead As Variant, arrAData As Variant, arrResult As Variant
    Dim i As Long, j As Long
    ' 关闭非必要性能开销
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' 定位有效数据边界
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    lngLastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    ' 把表头、A列原始值一次性读入内存数组
    arrHead = Range(Cells(1, "B"), Cells(1, lngLastCol)).Value
    arrAData = Range("A2:A" & lngLastRow).Value
    
    ' 初始化和目标输出区域维度一致的结果数组
    ReDim arrResult(1 To UBound(arrAData, 1), 1 To UBound(arrHead, 2))
    
    ' 纯内存循环完成拼接，无工作表交互
    For i = 1 To UBound(arrAData, 1)
        For j = 1 To UBound(arrHead, 2)
            arrResult(i, j) = arrHead(1, j) & "_" & arrAData(i, 1)
        Next j
    Next i
    
    ' 把拼接完成的结果一次性写回工作表
    Range(Cells(2, "B"), Cells(lngLastRow, lngLastCol)).Value = arrResult
    
    ' 恢复初始环境设置
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

如果需要保留原有Do While循环结构，可通过以下方式降低耗时：

• 循环开始前关闭ScreenUpdating和自动计算，循环结束后恢复
• 循环中不要重复访问Cells对象获取固定值（如表头值），可提前存入变量减少重复IO
• 避免在循环中频繁切换工作表对象引用

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