基于列计数在对应行重复粘贴现有值的VBA实现问题

需求 #

根据每行第1列的计数数值，将该行内的非空单元格值，在该行后方重复粘贴对应次数（例如计数为8则重复粘贴8次）。

现有代码问题 #

你提供的VBA代码存在逻辑错误，导致无法实现需求：

• For XX = 2 To Cells(XX, 1) 中循环变量的终止条件引用自身，逻辑混乱，无法正确获取计数
• 嵌套循环顺序不合理，重复粘贴的目标位置计算错误
• 未处理无效计数（如0或空值）的情况

修正后的VBA代码 #

Sub RepeatValuesByCount()
    Dim lastRow As Long
    Dim lastCol As Long
    Dim repeatCount As Integer
    Dim currentRow As Long
    Dim currentCol As Long
    Dim targetCol As Long
    
    ' 获取数据的最后一行和最后一列，适配动态数据范围
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    ' 遍历每一行（从第2行开始，假设第1行是表头）
    For currentRow = 2 To lastRow
        ' 读取当前行的重复次数（第1列的值）
        repeatCount = Cells(currentRow, 1).Value
        ' 跳过计数为0或非数值的行
        If repeatCount <= 0 Then GoTo NextRow
        
        ' 遍历当前行的所有列，寻找非空单元格
        For currentCol = 2 To lastCol
            If Not IsEmpty(Cells(currentRow, currentCol)) Then
                ' 确定粘贴的起始目标列
                targetCol = currentCol + 1
                ' 一次性粘贴指定次数，比循环粘贴更高效
                Cells(currentRow, currentCol).Copy Destination:=Cells(currentRow, targetCol).Resize(1, repeatCount)
                ' 更新最后一列，避免后续处理重复覆盖
                lastCol = lastCol + repeatCount
            End If
        Next currentCol
NextRow:
    Next currentRow
End Sub

代码说明 #

1. 动态获取数据范围：不再固定行/列数，适配不同长度的数据集
2. 无效计数处理：直接跳过计数为0或无效的行，避免错误
3. 高效粘贴：用Resize方法一次性生成指定次数的复制，比逐次循环粘贴更快
4. 动态更新列范围：每次粘贴后更新最后一列位置，确保后续单元格处理正确

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