不规范表格汇总成一维表

学习真好啊

求助：不规范表格汇总成一维表



产品在备注和合计中间，但是中间的产品个数不确定。最后想生成当日汇总表格。

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.6.14
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
5.     p = ThisWorkbook.Path & ""
   
6.     ReDim brr(1 To 10000, 1 To 16)
   
7.     For Each f In fso.GetFolder(p).Files
   
8.         If InStr(f.Name, ThisWorkbook.Name) = 0 Then
   
9.             fn = fso.GetBaseName(f)
   
10.             Set wb = Workbooks.Open(f, 0)
    
11.             With wb.Sheets(1)
    
12.                 r = .Cells(Rows.Count, 1).End(3).Row
    
13.                 c = .UsedRange.Columns.Count
    
14.                 c1 = Application.WorksheetFunction.Match("合计", Rows(1), 0)
    
15.                 arr = .[a1].Resize(r, c)
    
16.                 wb.Close False
    
17.             End With
    
18.             For i = 2 To UBound(arr)
    
19.                 For j = 10 To c1 - 1 Step 4
    
20.                     If arr(i, j) <> Empty Then
    
21.                         m = m + 1
    
22.                         For x = 1 To 9
    
23.                             brr(m, x) = arr(i, x)
    
24.                         Next
    
25.                         brr(m, 10) = arr(i, c1 + 1)
    
26.                         brr(m, 11) = arr(i, c1 + 2)
    
27.                         brr(m, 12) = arr(1, j)
    
28.                         For y = 1 To 4
    
29.                             brr(m, 12 + y) = arr(i, j + y - 1)
    
30.                         Next
    
31.                     End If
    
32.                 Next
    
33.             Next
    
34.         End If
    
35.     Next f
    
36.     With sh
    
37.         .UsedRange.Offset(1).Clear
    
38.         .[a1].Resize(1, 16).Interior.Color = 49407
    
39.         With .[a2].Resize(m, 16)
    
40.             .Value = brr
    
41.             .Borders.LineStyle = 1
    
42.             .HorizontalAlignment = xlCenter
    
43.             .VerticalAlignment = xlCenter
    
44.         End With
    
45.     End With
    
46.     Application.ScreenUpdating = True
    
47.     MsgBox "OK！"
    
48. End Sub
    

复制代码

学习真好啊

ykcbf1100 发表于 2024-6-14 10:51
附件供参考。。。

收到，谢谢！

pxy0409

源表太不规范,好像除了VBA,没有更好的办法.不过源数据量过多时,VBA应该会很慢
或许可以用一下sql,源表列名需要手动修改,只写了一个表的:

select 实际下单日期,下单日期,团队,扫码类型,扫码编号,姓名,电话,地址,备注,发货日期,发货单号,"产品11" as 产品,`产品11` *1 as 数量 ,批号,生产日期,有效期 from [C:\Users\Administrator\下载\产品B.xlsx`.`Sheet1$A:X] where `产品11` *1>0  union all
select 实际下单日期,下单日期,团队,扫码类型,扫码编号,姓名,电话,地址,备注,发货日期,发货单号,"产品22" as 产品,`产品22` *1 as 数量 ,批号1,生产日期1,有效期1 from [C:\Users\Administrator\下载\产品B.xlsx`.`Sheet1$A:X] where `产品22` *1>0  union all
select 实际下单日期,下单日期,团队,扫码类型,扫码编号,姓名,电话,地址,备注,发货日期,发货单号,"产品33" as 产品,`产品33` *1 as 数量 ,批号2,生产日期2,有效期2 from [C:\Users\Administrator\下载\产品B.xlsx`.`Sheet1$A:X] where `产品33` *1>0