横向8列的10个横向表转换成只有8列的一个表

江林

表中每个sheet中有10个横向的表，想法是10个横向的转成1个纵向，没有思路用vba转成一个汇总表，如下图

想达到的表格，把构件号写在A列

chxw68

1. Sub test()
   
2.     Dim r%, i%, c%, j%
   
3.     Dim arr, brr
   
4.     Dim reg As New RegExp
   
5.     With reg
   
6.         .Global = False
   
7.         .Pattern = "构件号:\s*(.+?)\s*件数"
   
8.     End With
   
9.     With Worksheets("汇总表")
   
10.         .Cells.Clear
    
11.     End With
    
12.     m = 1
    
13.     With Worksheets("sheet1")
    
14.         c = .Cells(2, .Columns.Count).End(xlToLeft).Column
    
15.         For j = 1 To c Step 8
    
16.             r = .Cells(.Rows.Count, j).End(xlUp).Row
    
17.             Set mh = reg.Execute(.Cells(1, j).Value)
    
18.             ss = mh(0).SubMatches(0)
    
19.             .Cells(1, j).Resize(r, 8).Copy Worksheets("汇总表").Cells(m, 2)
    
20.             Worksheets("汇总表").Cells(m, 1).Resize(r, 1) = ss
    
21.             m = m + r
    
22.         Next
    
23.     End With
    
24. End Sub
    

复制代码

chxw68

详见附件。

江林

chxw68 发表于 2024-4-11 08:40
详见附件。

非常感谢，确定达到了跟我说的一样，O(∩_∩)O谢谢！