求助按模板拆分明细，并对明细分类汇总的代码

老丢710 · 发表于 2024-5-8 10:27

本帖最后由老丢710 于 2024-5-8 10:59 编辑

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

ykcbf1100 · 发表于 2024-5-8 11:23

附件供参考。。。

ykcbf1100 · 发表于 2024-5-8 11:24

参与一下。。。

Sub ykcbf() '//2024.5.8
Dim arr, d
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim tm: tm = Timer
Set ws = ThisWorkbook
Set sh = ws.Sheets("结算表")
With ws.Sheets("供应商信息")
zrr = .UsedRange
For i = 2 To UBound(zrr)
s = zrr(i, 2)
d1(s) = i
Next
End With
bt = 1: col = 6
For Each sht In ws.Sheets
If sht.Name <> sh.Name And sht.Name <> "说明" And sht.Name <> "数据" And sht.Name <> "供应商信息" Then sht.Delete
Next
arr = ws.Sheets("数据").UsedRange
For i = bt + 1 To UBound(arr)
s = arr(i, col): ss = arr(i, 2)
If s <> Empty Then
If Not d.Exists(s) Then Set d(s) = CreateObject("scripting.dictionary")
If Not d(s).Exists(ss) Then Set d(s)(ss) = CreateObject("scripting.dictionary")
d(s)(ss)(i) = i
End If
Next i
On Error Resume Next
For Each k In d.keys
zj = 0
sh.Copy after:=ws.Sheets(ws.Sheets.Count)
Set sht = ws.Sheets(ws.Sheets.Count)
ReDim brr(1 To 30, 1 To 7)
m = 0
With sht
.Name = k
.[a8:g30] = ""
.[a6] = k
For x = 3 To 7
.Cells(6, x) = zrr(d1(k), x)
Next
n = 0
For Each kk In d(k).keys
Sum = 0
For Each kkk In d(k)(kk).keys
m = m + 1: n = n + 1
brr(m, 1) = n
For j = 2 To UBound(arr, 2) - 1
brr(m, j) = arr(kkk, j)
Next
Sum = Sum + brr(m, 5)
Next
m = m + 1
brr(m, 2) = kk & " 汇总": brr(m, 5) = Sum
zj = zj + Sum
Next
m = m + 1
brr(m, 2) = "总计": brr(m, 5) = zj
.[a8].Resize(m, 7) = brr
End With
Next k
ws.Sheets("数据").Activate
Set d = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "共用时：" & Format(Timer - tm) & "秒！"
End Sub

复制代码

老丢710 · 发表于 2024-5-8 12:24

感谢大神，可以实现，只是模板表中最下面的签字行没有保留，能不能改一下。

ykcbf1100 · 发表于 2024-5-8 12:39

老丢710 发表于 2024-5-8 12:24
感谢大神，可以实现，只是模板表中最下面的签字行没有保留，能不能改一下。

你没细看吧，签字行在的啊，我又没改，我只是中间加了4行。

老丢710 · 发表于 2024-5-8 12:56

ykcbf1100 发表于 2024-5-8 12:39
你没细看吧，签字行在的啊，我又没改，我只是中间加了4行。

我可能改了什么地方，宏运行后没有下面的签字行，是不是数据表中必须排序

ykcbf1100 · 发表于 2024-5-8 14:20

老丢710 发表于 2024-5-8 12:56
我可能改了什么地方，宏运行后没有下面的签字行，是不是数据表中必须排序

不需要排序。你用我的附件就可以了。

老丢710 · 发表于 2024-5-8 14:58

实际应用中数据较多，拆分出来的表也非常多，能不能将拆分出来的表中汇总行加黑加粗，总计行下到签字行多出来的空行删除掉

ykcbf1100 · 发表于 2024-5-8 15:04

老丢710 发表于 2024-5-8 14:58
实际应用中数据较多，拆分出来的表也非常多，能不能将拆分出来的表中汇总行加黑加粗，总计行下到签字行多出 ...

可以是可以，那得加代码啊

老丢710 · 发表于 2024-5-8 15:10

麻烦帮忙

		自动登录	找回密码
密码			免费注册

[求助] 求助按模板拆分明细，并对明细分类汇总的代码

评分

评分