转置数据

zllyyz

如题，卡在输出这里了，黄色结果部分数据出不来....烦请大神指教

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.1.22
   
2.     Set sh = Sheets("Sheet1")
   
3.     ReDim brr(1 To 10000, 1 To 4)
   
4.     For Each sht In Sheets
   
5.         If sht.Name <> sh.Name Then
   
6.             With sht
   
7.                 arr = .Range("a8:z20")
   
8.                 For j = 2 To UBound(arr, 2)
   
9.                     If arr(1, j) <> Empty Then
   
10.                         For i = 3 To UBound(arr)
    
11.                             If arr(i, 1) <> Empty Then
    
12.                                 m = m + 1
    
13.                                 brr(m, 1) = .Name
    
14.                                 brr(m, 2) = arr(1, j)
    
15.                                 brr(m, 3) = arr(i, 1)
    
16.                                 brr(m, 4) = arr(i, j)
    
17.                             End If
    
18.                         Next
    
19.                     End If
    
20.                 Next
    
21.             End With
    
22.         End If
    
23.     Next
    
24.     With sh
    
25.         .[c5:z10000].Clear
    
26.         With .[c5].Resize(m, 4)
    
27.             .Value = brr
    
28.             .Borders.LineStyle = 1
    
29.             .HorizontalAlignment = xlCenter
    
30.             .VerticalAlignment = xlCenter
    
31.         End With
    
32.     End With
    
33.     MsgBox "OK！"
    
34. End Sub
    
35. 
    

复制代码

ykcbf1100

附件供参考。。。

zllyyz

ykcbf1100 发表于 2024-1-22 15:21
附件供参考。。。

原来如此 得将数组的数据再装入一个数组里，明白了 谢谢老师

ykcbf1100

zllyyz 发表于 2024-1-22 15:56
原来如此 得将数组的数据再装入一个数组里，明白了 谢谢老师

源数据和结果数据大小不同的，所以，必须用另一个数组。