各位大神，帮帮我怎么自动生成数据表

chxw68

只写了生成[发票基本信息]的代码。

chxw68

详见附件。

chxw68

优化一下。

quqiyuan

参与一下，仅供参考。。。。

quqiyuan

代码如下。。。
Sub test()
    Dim wb As Workbook, sht As Worksheet
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("开票信息")
    Set sh = wb.Sheets("发票基本信息")
    Set sh1 = wb.Sheets("发票明细信息")
    drr = sh1.[p1].CurrentRegion
    arr = sht.[a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    ReDim brr(1 To 10000, 1 To 100)
    ReDim crr(1 To 10000, 1 To 100)
    For i = 2 To UBound(arr)
        s = arr(i, 1)
        If Not d.exists(s) Then
            n = n + 1
            d(s) = n
        End If
        m = d(s)
        brr(m, 1) = m
        brr(m, 2) = "普通发票"
        brr(m, 4) = "是"
        brr(m, 6) = arr(i, 3)
        brr(m, 99) = brr(m, 99) + arr(i, 5)
        brr(m, 100) = brr(m, 100) + arr(i, 6)
        brr(m, 16) = "贸易方式：一般贸易" & Chr(10) & "币别: 美元" _
                    & Chr(10) & "原币金额：" & brr(m, 100) & Chr(10) & "汇率：" _
                    & arr(i, 7) & Chr(10) & "报关编号：" & arr(i, 2) & Chr(10) & _
                    "订单编号：" & arr(i, 1)
        crr(m, 2) = arr(i, 4)
        crr(m, 3) = "'" & Application.VLookup(arr(i, 4), drr, 2, 0)
        crr(m, 5) = "盒"
        crr(m, 6) = brr(m, 99)
        crr(m, 8) = brr(m, 100)
        crr(m, 9) = 0
    Next
    sh.[a1].CurrentRegion.Offset(3).ClearContents
    sh1.[a1].CurrentRegion.Offset(3).ClearContents
    sh.[a4].Resize(n, 29) = brr
    sh1.[a4].Resize(n, 13) = crr
    Beep
End Sub

哦滴个神啊

chxw68 发表于 2024-12-18 17:01
只写了生成[发票基本信息]的代码。

非常感谢您，

哦滴个神啊

quqiyuan 发表于 2024-12-18 17:44
参与一下，仅供参考。。。。

红色框里这一栏金额能帮我改成取开票信息表中开票金额那一栏吗？

quqiyuan

哦滴个神啊 发表于 2024-12-19 11:11
红色框里这一栏金额能帮我改成取开票信息表中开票金额那一栏吗？

已经改好，请测试。。。。

quqiyuan

代码如下，，，，
Sub test()
    Dim wb As Workbook, sht As Worksheet
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("开票信息")
    Set sh = wb.Sheets("发票基本信息")
    Set sh1 = wb.Sheets("发票明细信息")
    drr = sh1.[p1].CurrentRegion
    arr = sht.[a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    ReDim brr(1 To 10000, 1 To 100)
    ReDim crr(1 To 10000, 1 To 100)
    For i = 2 To UBound(arr)
        s = arr(i, 1)
        If Not d.exists(s) Then
            n = n + 1
            d(s) = n
        End If
        m = d(s)
        brr(m, 1) = m
        brr(m, 2) = "普通发票"
        brr(m, 4) = "是"
        brr(m, 6) = arr(i, 3)
        brr(m, 99) = brr(m, 99) + arr(i, 5)
        brr(m, 100) = brr(m, 100) + arr(i, 6)
        brr(m, 98) = brr(m, 98) + arr(i, 8)
        brr(m, 16) = "贸易方式：一般贸易" & Chr(10) & "币别: 美元" _
                    & Chr(10) & "原币金额：" & brr(m, 100) & Chr(10) & "汇率：" _
                    & arr(i, 7) & Chr(10) & "报关编号：" & arr(i, 2) & Chr(10) & _
                    "订单编号：" & arr(i, 1)
        crr(m, 1) = m
        crr(m, 2) = arr(i, 4)
        crr(m, 3) = "'" & Application.VLookup(arr(i, 4), drr, 2, 0)
        crr(m, 5) = "盒"
        crr(m, 6) = brr(m, 99)
        crr(m, 8) = brr(m, 98)
        crr(m, 9) = 0
    Next
    sh.[a1].CurrentRegion.Offset(3).ClearContents
    sh1.[a1].CurrentRegion.Offset(3).ClearContents
    sh.[a4].Resize(n, 29) = brr
    sh1.[a4].Resize(n, 13) = crr
    Beep
End Sub

哦滴个神啊

quqiyuan 发表于 2024-12-19 13:26
已经改好，请测试。。。。

你好，麻烦您帮我再优化一下，具体要求我写在表每页表格里了，谢谢您