VBA实现指定列触发条件时后续15行重复填充指定值问题

首先给出可直接运行的完整代码：

Sub InsertP()
    Dim i As Long
    ' 关闭屏幕刷新，大幅提升大批量数据处理速度
    Application.ScreenUpdating = False
    
    For i = 1 To 400000
        If Cells(i, 4) = 1 Then
            ' 从当前行第1列开始，连续15行批量填充"P"
            Cells(i, 1).Resize(15, 1) = "P"
        End If
    Next i
    
    ' 恢复屏幕刷新设置
    Application.ScreenUpdating = True
End Sub

代码修改说明 #

• 语法修复：补充了原代码缺失的End If、Next i语句，修正了代码结构错误
• 变量优化：将计数变量i的类型从Double调整为Long，整数类型更适配行号计数场景，无精度风险、运行效率更高
• 核心逻辑实现：通过Resize(15, 1)方法选中当前行开始的15行1列区域，一次性批量赋值，相比逐行写入效率提升明显
• 性能优化：新增屏幕刷新开关，处理40万行数据时可避免频繁重绘界面，大幅降低运行耗时

可选适配优化 #

如果不需要固定遍历40万行，想自动适配当前表格的实际数据行数，可替换循环部分的代码：

Dim maxRow As Long
' 自动获取第4列的最后一个非空行号
maxRow = Cells(Rows.Count, 4).End(xlUp).Row
For i = 1 To maxRow
    If Cells(i, 4) = 1 Then
        Cells(i, 1).Resize(15, 1) = "P"
    End If
Next i

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