VBA循环实现单元格复制粘贴至后续列直至匹配指定数值问题咨询

实现逻辑 #

• 从第12行开始逐行处理，默认D列无内容时自动终止循环
• 每行先校验D列数值合法性，避免非正整数时出现报错
• 采用批量赋值替代剪贴板复制粘贴操作，执行效率更高，不会影响系统剪贴板内容

可用代码 #

Sub FillRightByCount()
    Dim ws As Worksheet
    Dim startRow As Long, curRow As Long
    Dim fillNum As Long
    
    ' 可修改为指定工作表，例如 Set ws = ThisWorkbook.Sheets("你的工作表名")
    Set ws = ActiveSheet
    startRow = 12
    curRow = startRow
    
    Do While ws.Cells(curRow, "D").Value <> ""
        fillNum = ws.Cells(curRow, "D").Value
        ' 仅当D列为正整数时执行填充
        If IsNumeric(fillNum) And fillNum > 0 Then
            ' 从I列开始向右填充fillNum个单元格，值等于当前行H列内容
            ws.Cells(curRow, "I").Resize(1, fillNum).Value = ws.Cells(curRow, "H").Value
        End If
        curRow = curRow + 1
    Loop
End Sub

适配说明 #

代码完全匹配需求场景：

• D12值为20时，I列序号为9，9+20-1=28，对应列号为AB列，填充到AB12后停止
• D13值为15时，9+15-1=23，对应列号为R列，填充到R13后停止

如果需要固定处理到指定结束行，可将Do While循环替换为For循环，例如需要处理12行到200行，修改为For curRow = 12 To 200即可。

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