Excel VBA 自动化工具：按日期将数据填充到多个表格

Sub FillData() Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets('Sheet1') Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets('Sheet2') Dim lastRow1 As Long: lastRow1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row Dim lastRow2 As Long: lastRow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row Dim i As Long, j As Long, k As Long, tableCounter As Long tableCounter = 0 '计数器，统计填充了几个表格 For i = 2 To lastRow1 Dim dateValue As Date: dateValue = ws1.Cells(i, "A").Value Dim rowCount As Long: rowCount = 0 For j = 4 To lastRow2 Step 10 '每10行一个表格 Dim isSameDate As Boolean: isSameDate = False For k = 1 To 3 '比较表格中的日期是否与当前日期相同 If ws2.Cells(j + k - 1, "A").Value = dateValue Then isSameDate = True Exit For End If Next k If Not isSameDate Then '如果表格中没有相同日期，则在该表格中填充数据 For k = 1 To 7 If ws2.Cells(j + 3 + k - 1, "A").Value = "" Then ws2.Range(ws2.Cells(j + 3 + k - 1, "B"), ws2.Cells(j + 3 + k - 1, "J")).Value = ws1.Range(ws1.Cells(i, "B"), ws1.Cells(i, "J")).Value rowCount = rowCount + 1 Exit For End If Next k If rowCount > 6 Then '如果已经填充了7行，则跳到下一个表格 tableCounter = tableCounter + 1 Exit For End If End If Next j If j > lastRow2 Then '如果已经遍历了所有表格仍然没有可填充的表格，则新建一个表格 tableCounter = tableCounter + 1 ws2.Range(ws2.Cells((tableCounter - 1) * 10 + 1, "A"), ws2.Cells((tableCounter - 1) * 10 + 3, "J")).Value = Array(Array("标题1"), Array("标题2"), Array("标题3")) For k = 1 To 7 ws2.Range(ws2.Cells((tableCounter - 1) * 10 + 3 + k, "A"), ws2.Cells((tableCounter - 1) * 10 + 3 + k, "J")).Value = ws1.Range(ws1.Cells(i, "B"), ws1.Cells(i, "J")).Value Next k End If Next i End Sub