如何用Excel 2016 VBA将输出表空白单元格填充为上方对应值

一、原代码的有效性 #

你的代码基本能实现核心需求：

• 对A列空白单元格，填充上一行单元格值+1
• 对B-H列空白单元格，复制上一行单元格值
• 当B-H列某行的左侧单元格有内容时，终止当前列的循环

但存在几个潜在问题：

• On Error Resume Next会掩盖错误（比如"Protocol"工作表不存在时，代码不会报错，后续操作会因wsProtocol为Nothing而崩溃）
• 仅以A列的最后一行作为遍历终点，如果其他列数据行数超过A列，会遗漏这些行的空白填充
• Exit For逻辑可能不符合预期：一旦某行左侧有值，就停止当前列后续行的遍历，若后续行仍有空白需要填充，会被忽略
• 逐单元格循环操作，数据量大时运行效率较低
• IsEmpty无法识别单元格为空文本（""）的情况，这类"空白"不会被处理

二、优化建议 #

1. 移除错误屏蔽，添加明确错误处理 #

去掉On Error Resume Next，改为捕获具体错误，避免隐藏问题：

On Error GoTo ErrHandler
'... 代码主体 ...
Exit Sub
ErrHandler:
    MsgBox "错误：" & Err.Description, vbCritical

2. 取所有列的最大最后一行 #

避免遗漏超出A列行数的其他列数据：

LastRow = wsProtocol.UsedRange.Rows(wsProtocol.UsedRange.Rows.Count).Row

3. 调整Exit For逻辑（按需选择） #

如果你的需求是仅跳过当前有左侧数据的单元格，继续处理后续行，把Exit For改为跳过当前行的逻辑：

If col > 1 And Len(Trim(.Cells(row, col - 1).Value)) > 0 Then
    GoTo NextRow ' 跳过当前单元格，继续下一行
End If

4. 用批量操作提升效率 #

通过SpecialCells批量定位空白单元格，减少循环次数，大幅提升大数据量下的运行速度：

' 处理A列：填充上一行+1
With wsProtocol.Range("A2:A" & LastRow)
    On Error Resume Next ' 防止没有空白单元格时报错
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C+1"
    On Error GoTo 0
    .Value = .Value ' 把公式转为数值
End With

' 处理B-H列：复制上一行值
For col = 2 To 8
    With wsProtocol.Range(wsProtocol.Cells(2, col), wsProtocol.Cells(LastRow, col))
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        On Error GoTo 0
        .Value = .Value
    End With
Next col

5. 统一空白判断逻辑 #

用Len(Trim(.Cells(row, col).Value)) = 0替代IsEmpty，既能识别真正的空单元格，也能识别空文本：

If Len(Trim(.Cells(row, col).Value)) = 0 Then
    ' 处理逻辑
End If

三、优化后的完整代码 #

Sub FillBlanksProtocol()
    Dim wsProtocol As Worksheet
    Dim LastRow As Long
    Dim col As Integer
    Dim row As Long
    
    ' 错误处理
    On Error GoTo ErrHandler
    
    ' 定位目标工作表
    Set wsProtocol = ThisWorkbook.Sheets("Protocol")
    
    ' 获取所有列的最大最后一行
    LastRow = wsProtocol.UsedRange.Rows(wsProtocol.UsedRange.Rows.Count).Row
    
    ' 处理A列：空白单元格填充上一行值+1
    With wsProtocol.Range("A2:A" & LastRow)
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C+1"
        On Error GoTo 0
        .Value = .Value ' 公式转数值
    End With
    
    ' 处理B-H列：空白单元格复制上一行值，左侧有值时跳过当前单元格
    For col = 2 To 8
        For row = 2 To LastRow
            With wsProtocol
                ' 判断单元格是否为空白（包含空文本）
                If Len(Trim(.Cells(row, col).Value)) = 0 Then
                    ' 左侧有值则跳过当前单元格
                    If col > 1 And Len(Trim(.Cells(row, col - 1).Value)) > 0 Then
                        GoTo NextRow
                    End If
                    ' 填充上一行值
                    If Len(Trim(.Cells(row - 1, col).Value)) > 0 Then
                        .Cells(row, col).Value = .Cells(row - 1, col).Value
                    End If
                End If
NextRow:
            End With
        Next row
    Next col
    
    Exit Sub
ErrHandler:
    MsgBox "错误：" & Err.Description, vbCritical
End Sub

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