修改原有代码，实现现在模板的拆分

老丢710

求助哪位大神能帮忙改一下原来模板的代码，实现现在模板的拆分要求，万分感谢！

ykcbf1100

附件供参考。。。

ykcbf1100

原帖上已回复，这里再发一次吧。

大部分代码已重写。

1. Sub ykcbf()  '//2024.5.13
   
2.     Dim arr, d, zj(), sum()
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     Dim tm: tm = Timer
   
7.     Set ws = ThisWorkbook
   
8.     Set sh = ws.Sheets("供应明细表")
   
9.     bt = 3: col = 6
   
10.     For Each sht In ws.Sheets
    
11.         If sht.Name <> sh.Name And sht.Name <> "说明" And sht.Name <> "数据" Then sht.Delete
    
12.     Next
    
13.     arr = ws.Sheets("数据").UsedRange
    
14.     For i = bt + 1 To UBound(arr)
    
15.         s = arr(i, col): ss = arr(i, 2)
    
16.         If s <> Empty Then
    
17.             If Not d.Exists(s) Then Set d(s) = CreateObject("scripting.dictionary")
    
18.             If Not d(s).Exists(ss) Then Set d(s)(ss) = CreateObject("scripting.dictionary")
    
19.             d(s)(ss)(i) = i
    
20.         End If
    
21.     Next i
    
22.     b = [{2,7,4,5}]: bb = [{4,5,6,9,10}]
    
23.     For Each k In d.keys
    
24.         ReDim zj(1 To 5)
    
25.         sh.Copy after:=ws.Sheets(ws.Sheets.Count)
    
26.         Set sht = ws.Sheets(ws.Sheets.Count)
    
27.         ReDim brr(1 To 30, 1 To 10)
    
28.         m = 0: lc = 26
    
29.         With sht
    
30.             n = 0
    
31.             .Name = k
    
32.             .[a2] = "供应明细表--" & .Name
    
33.             For Each kk In d(k).keys
    
34.                 ReDim sum(1 To 5)
    
35.                 For Each kkk In d(k)(kk).keys
    
36.                     m = m + 1: n = n + 1
    
37.                     brr(m, 1) = n
    
38.                     For j = 1 To UBound(b)
    
39.                         brr(m, j + 1) = arr(kkk, b(j))
    
40.                     Next
    
41.                     brr(m, 6) = Application.WorksheetFunction.Round(brr(m, 5) * 0.05, 2)
    
42.                     brr(m, 7) = "当前日期加一年"
    
43.                     brr(m, 8) = "5%"
    
44.                     brr(m, 9) = Application.WorksheetFunction.Round(brr(m, 4) * Val(brr(m, 8)), 2)
    
45.                     brr(m, 10) = Application.WorksheetFunction.Round(brr(m, 9) * 1.06, 2)
    
46.                     For x = 1 To 5
    
47.                         sum(x) = sum(x) + brr(m, bb(x))
    
48.                     Next
    
49.                 Next
    
50.                 m = m + 1
    
51.                 brr(m, 2) = kk & " 小计"
    
52.                 For x = 1 To 5
    
53.                     brr(m, bb(x)) = sum(x)
    
54.                 Next
    
55.                 For x = 1 To 5
    
56.                     zj(x) = zj(x) + sum(x)
    
57.                 Next
    
58.             Next
    
59.             m = m + 1
    
60.             brr(m, 2) = "总计"
    
61.             For x = 1 To 5
    
62.                 brr(m, bb(x)) = zj(x)
    
63.             Next
    
64.             k = lc - m
    
65.             If k > 0 Then .Rows(6 & ":" & 5 + k).Delete
    
66.             If k < 0 Then
    
67.                 For i = 1 To m - lc
    
68.                     .Cells(10 + i, 1).EntireRow.Insert
    
69.                 Next i
    
70.             End If
    
71.             .[a5].Resize(m, 10) = brr
    
72.             For i = 5 To 5 + m - 1
    
73.                 .Cells(i, 1).Resize(1, 10).ShrinkToFit = True
    
74.                 If Val(.Cells(i, 1)) = 0 Then
    
75.                     .Cells(i, 1).Resize(1, 10).Font.Bold = True
    
76.                     .Cells(i, 1).Resize(1, 10).Font.Name = "黑体"
    
77.                 End If
    
78.             Next
    
79.         End With
    
80.     Next k
    
81.     ws.Sheets("数据").Activate
    
82.     Set d = Nothing
    
83.     Application.DisplayAlerts = True
    
84.     Application.ScreenUpdating = True
    
85.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
86. End Sub
    

复制代码

老丢710

ykcbf1100 发表于 2024-5-13 11:56
附件供参考。。。

生成的表中“供应金额”和“供应金额（不含税）”取值反了，怎么改？

ykcbf1100

老丢710 发表于 2024-5-14 16:48
生成的表中“供应金额”和“供应金额（不含税）”取值反了，怎么改？

你数据表，那二个字段换一个位置好了。

ykcbf1100

老丢710 发表于 2024-5-14 16:48
生成的表中“供应金额”和“供应金额（不含税）”取值反了，怎么改？

还是我来改一下吧。

老丢710

ykcbf1100 发表于 2024-5-14 19:11
还是我来改一下吧。

在这加了个临时的变量，结果是不是一样的，我没看太明白，您改的地方为什么能调整过来

老丢710

ykcbf1100 发表于 2024-5-14 19:11
还是我来改一下吧。

实际应用中有相同的采购订单号，在拆分的表中没有汇总，另外服务费用计算有点问题，5%费率计算时按5进行计算了，是否能够再对订单号汇总显示？

ykcbf1100

老丢710 发表于 2024-5-15 12:59
实际应用中有相同的采购订单号，在拆分的表中没有汇总，另外服务费用计算有点问题，5%费率计算时按5进行 ...

我出去了二天。
你不要瞎改，搞清楚意思再改。费率计算那是小问题，订单号汇总那是要加代码了。

老丢710

ykcbf1100 发表于 2024-5-16 19:00
我出去了二天。
你不要瞎改，搞清楚意思再改。费率计算那是小问题，订单号汇总那是要加代码了。

您抽空给改一下订单号汇总行吗