按模板拆分明细，并分类汇总

老丢710

希望使用VBA自动成生结算表，要求将数据表中明细按照“供应商名称”字段拆分成多个工作表,填入结算表，并且按不同的”用料单位“进行分类汇，成表如例子。工作表名称按照供应商名称命名

3190496160

Sub 拆分()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ar As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
For Each sh In Sheets
    If sh.Index > 2 Then
        sh.Delete
    End If
Next sh
With Sheets("数据")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "数据为空！": End
    ar = .Range("a1:f" & r)
End With
For i = 2 To UBound(ar)
    If ar(i, 6) <> "" Then
        If Not d.exists(ar(i, 6)) Then Set d(ar(i, 6)) = CreateObject("scripting.dictionary")
        d(ar(i, 6))(ar(i, 2)) = d(ar(i, 6))(ar(i, 2)) + ar(i, 5)
    End If
Next i
For Each k In d.keys
    Sheets("结算表").Copy after:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = k
        .[c4] = k
        For Each kk In d(k).keys
            n = 0: hj = 0
            ReDim br(1 To UBound(ar), 1 To 5)
            For i = 2 To UBound(ar)
                If ar(i, 6) = k And ar(i, 2) = kk Then
                    n = n + 1
                    For j = 1 To 5
                        br(n, j) = ar(i, j)
                    Next j
                    hj = hj + ar(i, 5)
                End If
            Next i
            rs = .Cells(Rows.Count, 2).End(xlUp).Row + 1
            .Cells(rs, 1).Resize(n, UBound(br, 2)) = br
            .Cells(rs, 1).Resize(n + 1, UBound(br, 2) + 2).Borders.LineStyle = 1
            .Cells(rs + n, 2) = "汇总"
            .Cells(rs + n, 5) = hj
        Next kk
        ws = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Cells(ws, 2) = "(物资公司业务部门盖章)"
        .Cells(ws, 5) = "(物资公司财务部门盖章)"
        .Cells(ws + 1, 2) = "业务部门负责人："
        .Cells(ws + 1, 5) = "财务部门负责人:"
    End With
Next k
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "ok!"
End Sub

3190496160

样表.rar (29.9 KB, 下载次数: 9)

2024-5-8 11:53 上传

点击文件名下载附件

老丢710

运行后，20位发票不能正常显示，求解决

老丢710

20位发票号不能正常显示，结算表中最后两行拆分后还要再改格式，求大神再修改一下。

3190496160

老丢710 发表于 2024-5-8 12:43
运行后，20位发票不能正常显示，求解决

在计算表中把这一列设置为文本格式就行了吧

3190496160

样表.rar (51.63 KB, 下载次数: 3)

2024-5-9 08:27 上传

点击文件名下载附件

3190496160

代码稍作修改，仅供参考，
模板第六行是甚意思，恐怕只有楼主自己知道，实在不行可以加v

老丢710

3190496160 发表于 2024-5-9 08:28
代码稍作修改，仅供参考，
模板第六行是甚意思，恐怕只有楼主自己知道，实在不行可以加v

只是标黄了，那个位置填供应商名称，已经可以完美使用，感谢大神！另外再请教个问题，如果更换其他类似模板，按用料单位拆分（模板样式可能有微调），需要修改那些语句？

3190496160

老丢710 发表于 2024-5-10 18:58
只是标黄了，那个位置填供应商名称，已经可以完美使用，感谢大神！另外再请教个问题，如果更换其他类似模 ...

这么说太空宽泛了，没法回答你的，因为，不知道你的模板是什么样子，数据源是什么样子的