循环逻辑存疑，求实现指定单元格复制规则的Excel VBA代码

嘿，这个需求用Excel VBA就能完美解决！我给你准备了两种方案，分别适合不同的数据量场景，你可以按需选择：

方案一：基础循环法（适合小数据量） #

这种方法逻辑直观，容易理解，处理少量数据足够高效：

Sub CopyValuesRepeatedly()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRowSource As Long
    Dim i As Long
    Dim targetRow As Long
    
    ' 指定源工作表和目标工作表（注意名称要和你的实际表名一致）
    Set wsSource = ThisWorkbook.Worksheets("Worksheet 1")
    Set wsTarget = ThisWorkbook.Worksheets("Worksheet 2")
    
    ' 可选：清空目标工作表A列的旧数据，不需要的话可以注释掉这行
    wsTarget.Columns("A").ClearContents
    
    ' 获取源工作表A列最后一行有数据的行号，自动适配数据范围
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    targetRow = 1 ' 目标数据从A1开始写入
    
    ' 遍历源表每一行数据
    For i = 1 To lastRowSource
        ' 把当前源单元格的值批量写入目标表的4个连续单元格
        wsTarget.Range(wsTarget.Cells(targetRow, "A"), wsTarget.Cells(targetRow + 3, "A")).Value = wsSource.Cells(i, "A").Value
        ' 更新目标行，下一组数据从下4行开始
        targetRow = targetRow + 4
    Next i
    
    MsgBox "数据复制完成！", vbInformation
End Sub

关键说明： #

• 代码会自动识别源表A列的所有数据，不用手动指定范围
• 批量赋值Range.Value比逐个单元格复制更快
• 如果你的工作表名称不是Worksheet 1/Worksheet 2，记得修改代码里的工作表名称

方案二：数组高效法（适合大数据量） #

如果源表的数据很多（比如上千行），直接操作单元格会很慢，用数组在内存里处理速度会快很多：

Sub CopyValuesWithArray()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim sourceData As Variant
    Dim targetData As Variant
    Dim lastRowSource As Long
    Dim i As Long
    Dim j As Long
    
    Set wsSource = ThisWorkbook.Worksheets("Worksheet 1")
    Set wsTarget = ThisWorkbook.Worksheets("Worksheet 2")
    
    ' 可选：清空目标A列旧数据
    wsTarget.Columns("A").ClearContents
    
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    ' 检查源表是否有数据
    If lastRowSource = 0 Then
        MsgBox "源工作表A列没有数据！", vbExclamation
        Exit Sub
    End If
    
    ' 把源表A列数据一次性读入数组（减少和Excel单元格的交互）
    sourceData = wsSource.Range("A1:A" & lastRowSource).Value
    
    ' 定义目标数组：行数是源数据的4倍，列数1
    ReDim targetData(1 To lastRowSource * 4, 1 To 1)
    
    ' 循环填充目标数组，每个源值重复4次
    For i = 1 To lastRowSource
        For j = 1 To 4
            targetData((i - 1) * 4 + j, 1) = sourceData(i, 1)
        Next j
    Next i
    
    ' 把数组一次性写入目标表A列
    wsTarget.Range("A1").Resize(UBound(targetData, 1), 1).Value = targetData
    
    MsgBox "数据复制完成！", vbInformation
End Sub

关键说明： #

• 数组操作在内存中完成，避免了频繁读写Excel单元格，数据量越大优势越明显
• 加入了空数据检查，避免无数据时报错

使用步骤： #

1. 打开你的Excel文件，按下Alt + F11打开VBA编辑器
2. 在左侧工程窗口右键点击你的工作簿，选择「插入」→「模块」
3. 把上面任意一段代码粘贴到模块里
4. 修改代码中的工作表名称（如果和你的实际表名不一致）
5. 按下F5运行宏，或者回到Excel界面，点击「开发工具」→「宏」选择对应的宏执行

内容的提问来源于stack exchange，提问作者Arianne Gale Cruz