求助不规则的多列数据，合并提取到一个区域。

幸运方格

请看附件，谢谢。

baofa2

多列合并提取.zip (27.19 KB, 下载次数: 6)

2024-4-18 15:03 上传

点击文件名下载附件

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.4.18
   
2.     c = 4
   
3.     ReDim arr(1 To c)
   
4.     b = [{8,7,5,4}]
   
5.     With Sheets("表1")
   
6.         arr(1) = .[d11:n23]
   
7.         arr(2) = .[p11:z18]
   
8.         arr(3) = .[ab11:al21]
   
9.         arr(4) = .[an11:ax23]
   
10.     End With
    
11.     ReDim brr(1 To 1000, 1 To 5)
    
12.     For x = 1 To c
    
13.         For i = 2 To UBound(arr(x))
    
14.             m = m + 1
    
15.             brr(m, 1) = m
    
16.             For j = 2 To 4
    
17.                 brr(m, j) = arr(x)(i, j)
    
18.             Next
    
19.             brr(m, 5) = arr(x)(i, b(x))
    
20.         Next
    
21.     Next
    
22.     On Error Resume Next
    
23.     With Sheets("结果表")
    
24.         .[d11:h1000] = ""
    
25.         .[d11].Resize(m, 5) = brr
    
26.     End With
    
27.     MsgBox "OK！"
    
28. End Sub
    

复制代码

feilanga

........................

清风竹-

请看附件。