部分行转置后批量汇总问题

imroy

改了改，发现可以用了，代码贴出来：

1. Sub lkyy()
   
2. Dim wb As Workbook, Mp$, Mf
   
3. Mp = ThisWorkbook.Path & ""
   
4. Mf = Dir(Mp & "*.xlsx")
   
5. ReDim br(1 To 500, 1 To 10)
   
6. Do While Mf <> ""
   
7. With Workbooks.Open(Mp & Mf)
   
8.     n = n + 1
   
9.     ar = .Sheets("Page 1").Range("a1").CurrentRegion
   
10.     br(n, 1) = ar(3, 2)
    
11.     br(n, 2) = ar(4, 2)
    
12.     For i = 3 To 9
    
13.         br(n, i) = ar(i + 3, 2)
    
14.     Next
    
15.     For y = 150 To 20 Step -1
    
16.     If Cells(y, 1) = "" Then
    
17.              w = y - 1
    
18.           End If
    
19.       Next
    
20.     For i = 14 To w
    
21.         If i = 14 Then s = ar(i, 1) Else s = s & "|" & ar(i, 1)
    
22.     Next
    
23.     br(n, 10) = s
    
24.     .Close 0
    
25. End With
    
26. Mf = Dir()
    
27. Loop
    
28. Range("a2:j1000").ClearContents
    
29. Range("a2").Resize(n, 10) = br
    
30. End Sub

复制代码