将并排多列拆分成包含子文件夹工作簿

lele400024

ykcbf1100 发表于 2024-9-30 09:02
而且，人防就三个记录，你拆分成三个工作簿，而这三个工作簿中的数据都是一样的。你这个拆分逻辑有点问题啊 ...

数量确实有问题，我刚刚把附件更新了，
但是拆分逻辑应该是没有问题的，
例如电梯，人防，AGR等材料，先按Q列进行分类，人防类，其他参数都是一样的，例如名称、规格、单位、数量，只是两个不一样，就是品牌和价格不一样，例如华西人防，单价列为l，衡朔，单价列为N，华夏钢构，单价列为P

lele400024

ykcbf1100 发表于 2024-9-30 08:59
你数量用的是哪一列的数据？我看了你拆分后的工作表，数量都是1,和源数据对不上啊。

数量用的是源数据“I列”的数据

ykcbf1100

lele400024 发表于 2024-9-30 09:15
数量用的是源数据“I列”的数据

写好了，附件供参考。。。

ykcbf1100

稍有点复杂。。。

1. Sub ykcbf()  '//2024.9.30
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("Scripting.FileSystemObject")
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     Set d1 = CreateObject("Scripting.Dictionary")
   
7.     p = ThisWorkbook.Path & ""
   
8.     Set sh = ThisWorkbook.Sheets("报表格式")
   
9.     With Sheets("源数据")
   
10.         r = .Cells(Rows.Count, 1).End(3).Row
    
11.         c = .Cells(5, "XFD").End(1).Column
    
12.         arr = .[a1].Resize(r, c)
    
13.     End With
    
14.     For i = 5 To UBound(arr)
    
15.         s = arr(i, 17)
    
16.         If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
    
17.         For j = 11 To 16 Step 2
    
18.             ss = arr(i, j)
    
19.             s1 = ss & "|" & arr(i, 2)
    
20.             d1(s1) = arr(i, j + 1)
    
21.             If Not d(s).exists(ss) Then Set d(s)(ss) = CreateObject("Scripting.Dictionary")
    
22.             d(s)(ss)(i) = ""
    
23.         Next
    
24.     Next
    
25.     t = d1.items
    
26.     For Each k In d.keys
    
27.         p1 = p & k & ""
    
28.         If Not fso.FolderExists(p1) Then fso.CreateFolder p1
    
29.         For Each kk In d(k).keys
    
30.             sh.Copy
    
31.             Set wb = ActiveWorkbook
    
32.             ReDim brr(1 To 100, 1 To 100)
    
33.             m = 0
    
34.             With wb.Sheets(1)
    
35.                 .Name = kk
    
36.                 For Each kkk In d(k)(kk).keys
    
37.                     m = m + 1
    
38.                     brr(m, 1) = m
    
39.                     brr(m, 2) = arr(kkk, 2)
    
40.                     brr(m, 3) = kk
    
41.                     brr(m, 4) = arr(kkk, 5)
    
42.                     brr(m, 5) = arr(kkk, 3)
    
43.                     brr(m, 6) = arr(kkk, 9)
    
44.                     s = brr(m, 3) & "|" & brr(m, 2)
    
45.                     If d1.exists(s) Then
    
46.                         brr(m, 7) = d1(s)
    
47.                     End If
    
48.                     brr(m, 8) = Round(brr(m, 7) * brr(m, 6), 2)
    
49.                     brr(m, 9) = arr(kkk, 18)
    
50.                 Next
    
51.                 .[a4].Resize(m, 9) = brr
    
52.             End With
    
53.             wb.SaveAs p1 & k & "报价单-" & kk
    
54.             wb.Close
    
55.         Next
    
56.     Next
    
57.     Set d = Nothing
    
58.     Set d1 = Nothing
    
59.     Application.ScreenUpdating = True
    
60.     MsgBox "OK！"
    
61. End Sub
    
62. 
    

复制代码

lele400024

ykcbf1100 发表于 2024-9-30 09:50
写好了，附件供参考。。。

太感谢了，完全满足要求

lele400024

ykcbf1100 发表于 2024-9-30 09:51
稍有点复杂。。。

你好，在运行中，有些问题，关键字不仅仅是B列，应该是B列加E列，应为有些名称相同，材料参数不同。所以造成了数据错误。麻烦修改下代码，谢谢

ykcbf1100

lele400024 发表于 2024-9-30 15:04
你好，在运行中，有些问题，关键字不仅仅是B列，应该是B列加E列，应为有些名称相同，材料参数不同。所以 ...

你再试一下

lele400024

ykcbf1100 发表于 2024-9-30 15:09
你再试一下

可以了，还有一个需求，就是如果F列“不含税材料价”，能不能导出的时候，在报表格式中“G列”*1.13，保留两位小数

ykcbf1100

lele400024 发表于 2024-9-30 15:19
可以了，还有一个需求，就是如果F列“不含税材料价”，能不能导出的时候，在报表格式中“G列”*1.13，保 ...

你拆分时G列数据又用不到。

lele400024

ykcbf1100 发表于 2024-9-30 15:24
你拆分时G列数据又用不到。

可能我刚刚没表达清楚，
就是源数据表格中，“F列”如果值为“不含税材料价”，在拆分的过程中，源数据表格“L列”、“N列”、“P列”在导出到“报表格式”表格中G列时，能不能将原有数据乘以1.13。
原因是源数据表，我们要统计的是“不含税材料价”，拆分的表格中需要改成含税价（也就是要乘以1.13）