求助：修正VBA循环填充Sheet2表格的错误代码

需要编写VBA宏，用Sheet1中的数据填充Sheet2表格：

• 先统计Sheet1中的周期数量
• 每个周期对应Sheet2中3行数据，填充规则参考表格标注的颜色

现有代码无法正确完成填充，请求修正：

Sheet1数据示例 #

Sheet2目标表格 #

现有代码 #

Sub fillDate()

Dim periods As Long, i As Integer, j As Integer
    periods = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "E").End(xlUp).Row - 7

For i = 2 To 2 + (periods - 1) * 3 Step 3
    For j = 1 To periods
                ThisWorkbook.Sheets("Sheet2").Range("A" & i).Offset(0, 0).Value = ThisWorkbook.Sheets("Sheet1").Range("F7").Offset(j, 0).Value
                ThisWorkbook.Sheets("Sheet2").Range("A" & i).Offset(0, 1).Value = ThisWorkbook.Sheets("Sheet1").Range("F7").Offset(j, 0).Value
                ThisWorkbook.Sheets("Sheet2").Range("A" & i).Offset(0, 2).Value = ThisWorkbook.Sheets("Sheet1").Range("F7").Offset(j, 0).Value
                ThisWorkbook.Sheets("Sheet2").Range("A" & i).Offset(0, 3).Value = ThisWorkbook.Sheets("Sheet1").Range("F7").Offset(j, 3).Value
           
                ThisWorkbook.Sheets("Sheet2").Range("A" & i).Offset(1, 0).Value = ThisWorkbook.Sheets("Sheet1").Range("F7").Offset(j, 0).Value
                ThisWorkbook.Sheets("Sheet2").Range("A" & i).Offset(1, 1).Value = ThisWorkbook.Sheets("Sheet1").Range("F7").Offset(j, 0).Value
                ThisWorkbook.Sheets("Sheet2").Range("A" & i).Offset(1, 2).Value = ThisWorkbook.Sheets("Sheet1").Range("F7").Offset(j, 2).Value
                ThisWorkbook.Sheets("Sheet2").Range("A" & i).Offset(1, 3).Value = ThisWorkbook.Sheets("Sheet1").Range("F7").Offset(j, 3).Value
           
                ThisWorkbook.Sheets("Sheet2").Range("A" & i).Offset(2, 0).Value = ThisWorkbook.Sheets("Sheet1").Range("F7").Offset(j, 2).Value
                ThisWorkbook.Sheets("Sheet2").Range("A" & i).Offset(2, 1).Value = ThisWorkbook.Sheets("Sheet1").Range("F7").Offset(j, 2).Value
                ThisWorkbook.Sheets("Sheet2").Range("A" & i).Offset(2, 2).Value = ThisWorkbook.Sheets("Sheet1").Range("F7").Offset(j, 2).Value
                ThisWorkbook.Sheets("Sheet2").Range("A" & i).Offset(2, 3).Value = ThisWorkbook.Sheets("Sheet1").Range("F7").Offset(j, 3).Value
    Next j
Next i
End Sub

问题分析与修正代码 #

原代码核心问题是嵌套循环逻辑错误：外层按3行步长遍历Sheet2的行，内层又遍历所有周期，导致每个Sheet2的起始行被所有周期的数据覆盖，最终只保留最后一个周期的内容。此外，重复引用工作表会降低代码效率，优化后代码如下：

Sub fillDate()
    Dim periods As Long, i As Long, j As Long
    Dim ws1 As Worksheet, ws2 As Worksheet
    
    ' 定义工作表对象，简化引用并提升效率
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")
    
    ' 统计周期数量：假设周期数据从E8开始，计算E列最后非空行与第7行的差值
    periods = ws1.Cells(ws1.Rows.Count, "E").End(xlUp).Row - 7
    
    ' 遍历每个周期，直接计算对应Sheet2的起始行
    For j = 1 To periods
        ' 每个周期对应Sheet2的3行，起始行从第2行开始，公式为：2 + (周期序号-1)*3
        i = 2 + (j - 1) * 3
        
        ' 填充当前周期第1行
        ws2.Cells(i, "A").Value = ws1.Range("F7").Offset(j, 0).Value
        ws2.Cells(i, "B").Value = ws1.Range("F7").Offset(j, 0).Value
        ws2.Cells(i, "C").Value = ws1.Range("F7").Offset(j, 0).Value
        ws2.Cells(i, "D").Value = ws1.Range("F7").Offset(j, 3).Value
        
        ' 填充当前周期第2行
        ws2.Cells(i + 1, "A").Value = ws1.Range("F7").Offset(j, 0).Value
        ws2.Cells(i + 1, "B").Value = ws1.Range("F7").Offset(j, 0).Value
        ws2.Cells(i + 1, "C").Value = ws1.Range("F7").Offset(j, 2).Value
        ws2.Cells(i + 1, "D").Value = ws1.Range("F7").Offset(j, 3).Value
        
        ' 填充当前周期第3行
        ws2.Cells(i + 2, "A").Value = ws1.Range("F7").Offset(j, 2).Value
        ws2.Cells(i + 2, "B").Value = ws1.Range("F7").Offset(j, 2).Value
        ws2.Cells(i + 2, "C").Value = ws1.Range("F7").Offset(j, 2).Value
        ws2.Cells(i + 2, "D").Value = ws1.Range("F7").Offset(j, 3).Value
    Next j
    
    ' 释放对象变量
    Set ws1 = Nothing
    Set ws2 = Nothing
End Sub

修正说明 #

1. 移除错误的嵌套循环：改为遍历每个周期，直接计算该周期在Sheet2的起始行，避免数据覆盖
2. 使用工作表对象变量：减少重复引用ThisWorkbook.Sheets()的操作，代码更简洁高效
3. 明确行位置映射：确保每个周期的3行数据准确写入Sheet2的对应位置，符合颜色标注的填充规则

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