列转行，请各位大佬，帮帮忙，谢谢！

Qs18

试试..........

Again123456

数据模板.rar (10.51 KB, 下载次数: 6)

2024-10-31 15:55 上传

点击文件名下载附件

wps jsa 参与一下

z865593849

张小生

1. Sub test()
   
2. Dim brr(1 To 20000, 1 To 13), ar, cr
   
3. Dim d%, k%, z%, x%, y%, j%, m%, n%
   
4. k = Cells(1, 12).End(xlToRight).Column
   
5. d = Range("n60000").End(3).Row
   
6. cr = Range(Cells(1, 12), Cells(d, k))
   
7. ar = Range("a1:k" & d)
   
8. For z = 1 To UBound(ar, 2)
   
9.     brr(1, z) = ar(1, z)
   
10. Next z
    
11. brr(1, 12) = "日期": brr(1, 13) = "数量"
    
12. For x = 2 To UBound(ar)
    
13.     n = n + 1
    
14.     For y = 1 To UBound(cr, 2)
    
15.         j = j + 1
    
16.         For m = 1 To 11
    
17.             brr(j + 1, m) = ar(x, m)
    
18.         Next m
    
19.         brr(j + 1, 12) = cr(1, y)
    
20.         brr(j + 1, 13) = cr(n + 1, y)
    
21.     Next y
    
22. Next x
    
23. With Range("a8").Resize(j + 1, 13)
    
24.     .ClearContents
    
25.     .NumberFormatLocal = "G/通用格式"
    
26.     .Borders.LineStyle = True
    
27. End With
    
28. Range("a8").Resize(j + 1, 13) = brr
    
29. End Sub
    

复制代码