VBA循环查找非空单元格在相邻列填充文本的代码故障排查

参考数据集示例如下：

原代码问题分析 #

原代码出现持续运行无法退出、仅能填充单个单元格的核心原因有两个：

• 初始单元格定位逻辑偏差：代码从A列向上查找最后非空单元格再做偏移，而实际数据源为B列，当A列存在未填充空行、B列已写入数据时，定位范围会出现错误
• 循环缺少步进逻辑：Do Until循环执行过程中，BlankCell对象始终指向初始定位的第一个单元格，没有逐行向下移动的逻辑，因此会无限重复判断同一个单元格，造成程序持续运行无法退出，且永远只能填充第一个匹配行

可直接使用的修复代码 #

方案1：手动触发运行的宏（适配批量填充历史数据+新增数据） #

该版本会动态识别B列最新的最后一行数据，批量完成所有未填充行的内容写入，不会重复填充已有内容的单元格：

Sub FillOKForNonEmptyB()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim rowIdx As Long
    
    ' 指定操作的工作表
    Set ws = ThisWorkbook.Sheets("Pipeline")
    ' 从B列最后一行向上查找，动态获取最新的非空数据行号，自动适配每日新增条目
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' 从第6行开始遍历到B列最后一行，若起始行有调整直接修改此处的行号即可
    For rowIdx = 6 To lastRow
        ' 仅当B列当前行非空、且同行A列未填充内容时写入"OK"，避免覆盖已有内容
        If Not IsEmpty(ws.Cells(rowIdx, "B")) And IsEmpty(ws.Cells(rowIdx, "A")) Then
            ws.Cells(rowIdx, "A").Value = "OK"
        End If
    Next rowIdx
End Sub

方案2：自动触发填充（新增内容实时写入，无需手动运行宏） #

如果需要每次在B列新增内容时自动完成A列填充，可以使用工作表Change事件，配置完成后无需手动执行宏：

• 按Alt+F11打开VBA编辑器
• 在左侧工程资源管理器中双击Pipeline工作表对象
• 将以下代码粘贴到打开的代码窗口中保存即可

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim changedCell As Range
    ' 仅监控B列的单元格修改操作
    If Not Intersect(Target, Me.Columns("B")) Is Nothing Then
        ' 临时关闭事件触发，避免写入单元格时递归触发事件造成报错
        Application.EnableEvents = False
        For Each changedCell In Intersect(Target, Me.Columns("B"))
            ' B列写入内容、同行A列为空时自动填充"OK"
            If Not IsEmpty(changedCell.Value) And IsEmpty(changedCell.Offset(0, -1).Value) Then
                changedCell.Offset(0, -1).Value = "OK"
            End If
        Next changedCell
        ' 恢复事件触发
        Application.EnableEvents = True
    End If
End Sub

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