Excel VBA向下选中含空白行区域 填充公式至指定关键词行

问题根源 #

录制宏反复调用xlDown的逻辑本质是模拟快捷键跳转到连续数据区域边缘，只要遇到空单元格就会直接跳到下一段连续数据的底部，完全无法适配带空行、多表格的场景，这也是出现越界填充的核心原因。

核心实现逻辑 #

• 放弃依赖选区跳转、复制粘贴的录制宏写法，改用全表扫描+逐行边界判定的逻辑，天然兼容空行、不会越界
• 自动遍历当前工作表所有值为Total Price的公式表头，适配同工作表内多个位置不固定的独立表格，无需提前绑定表名
• 定位到每个Total Price单元格后，取其下第一行作为标准公式来源，从该行开始逐行向下检查，遇到包含Total内容的汇总行立即停止，将公式填充到两者之间的所有行
• 全程直接操作单元格对象，不依赖选中、激活操作，避免选区漂移问题

完整代码 #

Sub RefreshAllTotalPriceFormula()
    Dim ws As Worksheet
    Dim findHeader As Range
    Dim firstFindAddr As String
    Dim formulaSource As Range
    Dim currentRow As Long
    Dim endRow As Long
    Dim fillCol As Long
    
    Set ws = ActiveSheet
    ' 全表扫描"Total Price"表头
    Set findHeader = ws.UsedRange.Find( _
        What:="Total Price", _
        LookIn:=xlValues, _
        LookAt:=xlWhole)
    
    ' 无匹配表头直接退出
    If findHeader Is Nothing Then Exit Sub
    firstFindAddr = findHeader.Address
    
    ' 循环处理所有匹配到的独立表格
    Do
        fillCol = findHeader.Column
        Set formulaSource = findHeader.Offset(1, 0)
        currentRow = formulaSource.Row + 1
        endRow = 0
        
        ' 逐行向下定位表尾的"Total"标识
        Do
            ' 当前行任意位置存在"Total"即判定为到达汇总行，填充到上一行为止
            If Application.CountIf(ws.Rows(currentRow), "Total") > 0 Then
                endRow = currentRow - 1
                Exit Do
            End If
            currentRow = currentRow + 1
            ' 防死循环：超出已用区域边界直接终止
            If currentRow > ws.UsedRange.Row + ws.UsedRange.Rows.Count Then Exit Do
        Loop
        
        ' 边界有效时执行公式填充
        If endRow >= formulaSource.Row Then
            ws.Range(formulaSource, ws.Cells(endRow, fillCol)).Formula = formulaSource.Formula
        End If
        
        ' 定位下一个表头
        Set findHeader = ws.UsedRange.FindNext(findHeader)
    Loop While Not findHeader Is Nothing And findHeader.Address <> firstFindAddr
End Sub

使用说明 #

• 运行宏前无需提前选中单元格，会自动扫描当前工作表所有符合标识规则的表格
• 逐行遍历逻辑完全兼容表格数据区存在空白行的场景，不会出现跳选越界问题
• 直接通过Formula属性批量写入公式，比复制粘贴效率更高，无剪贴板占用问题
• 只要每个表格保留Total Price公式表头、底部保留带Total内容的汇总行，不管表格位置、行数如何动态变化，都能准确完成公式刷新
• 若需要调整匹配关键词，直接修改代码中Find方法的What参数、CountIf的匹配值即可

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