Excel VBA 自动化工具：按日期将数据填充到重复表格中

使用 Excel VBA 自动化填充重复表格

本工具旨在将 Sheet1 中的数据按日期填充到 Sheet2 中的多个重复表格中，每个表格最多容纳 7 行不同日期的数据，超过 7 行则填充到下一个表格。

Sheet1 数据结构

A1 列为日期，其余列为普通数据
共有 100 行数据

Sheet2 数据结构

每个表格包含 A1 到 A10 列
每个表格包含 10 行，其中 1 至 3 行为标题行，4 至 10 行为空白行
第 11 行至 20 行为新的表格，以此类推，每 10 行一个表格

VBA 代码

Sub FillData()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = ThisWorkbook.Sheets('Sheet1')
    Set ws2 = ThisWorkbook.Sheets('Sheet2')
    
    Dim i As Integer, j As Integer, k As Integer
    Dim lastRow1 As Long, lastRow2 As Long
    lastRow1 = ws1.Cells(Rows.Count, 'A').End(xlUp).Row
    
    For i = 2 To lastRow1 '从第二行开始，第一行为标题行
        If ws1.Cells(i, 'A') <> ws1.Cells(i - 1, 'A') Then '如果当前日期不同于上一行，则填充到下一个表格
            lastRow2 = ws2.Cells(Rows.Count, 'A').End(xlUp).Row '找到最后一个表格的最后一行
            If lastRow2 Mod 10 >= 7 Then '如果最后一个表格的最后一行已经填满，则新增一个表格
                lastRow2 = lastRow2 + 3 '新增一个表格需要占用 3 行空白行
            End If
            For j = 1 To 9 '在新的表格中填充标题
                ws2.Cells(lastRow2 + j, 1) = ws1.Cells(1, j)
            Next j
            k = 0 '计数器清零
        End If
        lastRow2 = ws2.Cells(Rows.Count, 'A').End(xlUp).Row '找到最后一个表格的最后一行
        If lastRow2 Mod 10 = 3 Then '如果最后一个表格的最后一行是空白行，则填充数据
            k = k + 1
            For j = 1 To 9
                ws2.Cells(lastRow2 + k + j, 1) = ws1.Cells(i, j)
            Next j
        End If
    Next i
End Sub

使用方法

将 VBA 代码复制到 Excel 中的 VBA 编辑器中
修改代码中 Sheet1 和 Sheet2 为您的工作簿名称
运行 FillData 子程序

代码解释

循环遍历 Sheet1 数据：循环从第二行开始，因为第一行为标题行。
判断日期是否改变：如果当前日期与上一行不同，则需要填充到新的表格中。
找到最后一个表格的最后一行：使用 Cells(Rows.Count, 'A').End(xlUp).Row 方法找到最后一个表格的最后一行。
判断表格是否已满：如果最后一个表格的最后一行已经填满（即 lastRow2 Mod 10 >= 7），则需要新增一个表格。
填充标题：在新的表格中填充标题行。
填充数据：如果最后一个表格的最后一行是空白行（即 lastRow2 Mod 10 = 3），则将当前行数据填充到该表格中。

注意事项

确保 Sheet2 中的表格结构符合要求。
如果 Sheet1 中的数据量很大，运行代码可能需要较长时间。

希望本工具可以帮助您高效地将数据填充到重复表格中。