两个表格，怎么把表一的数据，通过VBA按照我表格二的方式提取

saihebe

跪求大佬指点 先谢谢了。
就是把表格一的开始日期和天数
提取成表格二的模式

曦朔

感觉做了一个很简陋的。。。。hhh

3190496160

Sub test()
With Sheet1
    ws = .Cells(Rows.Count, 2).End(xlUp).Row
    ar = .Range("a4:e" & ws)
End With
Dim br()
ReDim br(1 To UBound(ar), 1 To 5)
For i = 2 To UBound(ar)
    If Trim(ar(i, 3)) <> "" Then
        n = n + 1
        br(n, 1) = ar(2, 1)
        br(n, 2) = ar(4, 1)
        br(n, 3) = ar(6, 1)
        br(n, 4) = ar(i, 3)
        br(n, 5) = ar(i, 5)
    End If
Next i
If n <> "" Then
    With Sheet2
        .[a1].CurrentRegion.Offset(1) = Empty
        .[a2].Resize(n, UBound(br, 2)) = br
    End With
End If
End Sub

3190496160

表一.rar (13.74 KB, 下载次数: 1)

2020-3-10 11:13 上传

点击文件名下载附件

petergaod

Sub test()
    Dim arr()
    With Sheet1
        mr = .[D65536].End(xlUp).Row
        num = Application.WorksheetFunction.Sum(.Range("D5:D" & mr))
        ReDim arr(1 To num, 1 To 5)
        brr = .[C5].Resize(mr - 4, 3)
        n = 1
        For i = 1 To UBound(brr)
            For j = 1 To brr(i, 2)
                arr(n, 1) = .Cells(5, 1)
                arr(n, 2) = .Cells(7, 1)
                arr(n, 3) = .Cells(9, 1)
                arr(n, 4) = brr(i, 1) + j - 1
                arr(n, 5) = brr(i, 3)
                n = n + 1
            Next
        Next
    End With
    Sheet2.[2:65536].ClearContents
    Sheet2.[A2].Resize(num, 5) = arr
End Sub

petergaod

附件供参考

话说，学校不放假吗

saihebe

petergaod 发表于 2020-3-10 11:28
附件供参考

话说，学校不放假吗

我实际内容不是这些，我就乱写的哈哈哈。我是两个表格分开提取。可以吗？不是sheet提取。

saihebe

3190496160 发表于 2020-3-10 11:13

谢谢大佬的帮忙， 但是我是两个表格分开提取。可以吗？不是sheet提取。

saihebe

各位大佬，因为我呢有很多个表1需要提取。有63个表1.  我想这63个表1提取汇总到一个新表里面。

3190496160

saihebe 发表于 2020-3-10 13:42
各位大佬，因为我呢有很多个表1需要提取。有63个表1.  我想这63个表1提取汇总到一个新表里面。

一开始就应该把你的真实意图说出来，别人也能整体考虑，一次性的帮你写好代码，这样挤牙膏似的提问题，代码改过来改过去的，岂不麻烦？本身就是做义务，没有多少人有很好的耐心的