Excel VBA公式跨列填充未自动调整问题求助

报表自动化收尾阶段遇到问题：通过VBA将活动单元格的公式填充至当前行尾再向下填充至行尾，但执行后所有列的公式及返回数据完全相同，公式未随列变化自动调整。

当前效果：所有列公式一致，返回数据无差异；预期效果：每列公式自动匹配对应数据源列，返回对应数据（手动操作后的正确效果）。

原代码问题分析 #

1. 直接通过Range("AD2", Cells(LastRow, LastCol)).FormulaR1C1 = Range("AD2").FormulaR1C1批量赋值，导致所有列复用AD2的固定公式，未动态调整数据源列引用
2. LastRow和LastCol未定义就直接使用，存在语法隐患
3. FillRight/FillDown的逻辑未考虑公式需要随列动态匹配不同数据源的需求

修改后的代码 #

Sub Macro4()
    Dim ws As Worksheet
    Dim startCell As Range
    Dim grirHeader As Range
    Dim importHeader As Range
    Dim currentCol As Long
    Dim lastCol As Long
    Dim lastRow As Long
    Dim targetHeader As String
    
    ' 指定操作工作表（可根据实际修改）
    Set ws = ActiveSheet
    
    ' 定位"AP Researched by"表头
    Set grirHeader = ws.Cells.Find(What:="AP Researched by", LookIn:=xlFormulas2, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    If grirHeader Is Nothing Then
        MsgBox "未找到表头'AP Researched by'"
        Exit Sub
    End If
    
    ' 设置起始单元格（表头下方第一行）
    Set startCell = grirHeader.Offset(1, 0)
    
    ' 获取数据区域的最后一列和最后一行
    lastCol = ws.Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    lastRow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    ' 遍历当前行目标列，生成对应公式
    For currentCol = grirHeader.Column To lastCol
        ' 提取当前列表头的核心名称（去掉"AP "前缀）
        targetHeader = Replace(ws.Cells(grirHeader.Row, currentCol).Value, "AP ", "")
        
        ' 在ImportTable中匹配对应表头
        Set importHeader = ws.ListObjects("ImportTable").HeaderRowRange.Find(What:=targetHeader, _
            LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
            
        If Not importHeader Is Nothing Then
            ' 给当前单元格设置动态匹配的公式
            ws.Cells(startCell.Row, currentCol).Formula2 = _
                "=IFERROR(INDEX(ImportTable[[" & targetHeader & "]],MATCH(GRIR_Table[@[PO/PO Line]],ImportTable[[PO/PO Line]],0)),"""")"
        End If
    Next currentCol
    
    ' 将第一行公式向下填充至最后一行
    ws.Range(startCell, ws.Cells(startCell.Row, lastCol)).AutoFill _
        Destination:=ws.Range(startCell, ws.Cells(lastRow, lastCol)), Type:=xlFillDefault
End Sub

代码说明 #

1. 动态表头匹配：通过去除当前列表头的"AP "前缀，精准匹配ImportTable中的对应数据源列，确保每列公式引用正确
2. 结构化引用：使用GRIR_Table[@[PO/PO Line]]这类结构化引用，保证公式填充时行/列引用自动适配
3. 高效填充：用AutoFill替代原有的FillDown，既保证填充效率，又保留引用的动态性
4. 错误处理：增加表头未找到的提示，避免无意义的运行报错

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