Sub FillData()

Dim ws1 As Worksheet '定义Sheet1 Dim ws2 As Worksheet '定义Sheet2 Dim date_rng As Range '定义日期列的范围 Dim data_rng As Range '定义数据列的范围 Dim tbl_rng As Range '定义表格范围 Dim tbl_row As Long '定义表格行数 Dim tbl_idx As Long '定义表格索引 Dim date_val As Variant '定义日期值 Dim data_val As Variant '定义数据值

Set ws1 = ThisWorkbook.Sheets("Sheet1") Set ws2 = ThisWorkbook.Sheets("Sheet2")

'获取日期和数据的范围 Set date_rng = ws1.Range("A2:A100") Set data_rng = ws1.Range("B2:B100")

'获取表格范围 Set tbl_rng = ws2.Range("A1:A200")

'初始化表格索引 tbl_idx = 1

'循环日期列 For Each date_val In date_rng

'获取当前日期的行数
tbl_row = (tbl_idx - 1) * 10 + 4

'如果当前行已经有数据,则增加表格索引
If ws2.Cells(tbl_row, 1) <> "" Then
    tbl_idx = tbl_idx + 1
End If

'判断当前日期是否已经填充过
If ws2.Cells(tbl_row, 1) <> date_val Then

    '填充日期
    ws2.Cells(tbl_row, 1) = date_val
    
    '填充数据
    For Each data_val In data_rng
        '如果当前行已经填满,则增加表格索引
        If tbl_row > (tbl_idx * 10) + 3 Then
            tbl_idx = tbl_idx + 1
            tbl_row = (tbl_idx - 1) * 10 + 4
        End If
        
        '填充数据
        ws2.Cells(tbl_row, 2) = data_val
        
        '增加行数
        tbl_row = tbl_row + 1
    Next data_val
    
End If

Next date_val

End Sub

Excel中有两个工作簿,sheet1中有数据A1到A10列,共有1到100行,A1列为日期,其余为普通数据,sheet2中有很多个重复表格,表格大小为A1到A10列,有10行,1至3行为标题行,第4至10行为空白行,第11行至20行为新的表格以此类推每10行一个表格,要求按照sheet1中的A1列的不同日期将全部数据填充在sheet2的表格空白行里,如果填不下就填在下一个表格里,注意不同日期的数据不允许填充在一个表格里。代码写出来

原文地址: http://www.cveoy.top/t/topic/rVC 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录