求助VBA

2801959927

1. Option Explicit
   
2. Sub Main()
   
3.     Dim arr, brr()
   
4.     Dim i, j, tgt As Integer
   
5.     arr = Sheet1.Range("A1").CurrentRegion
   
6.     For i = 1 To UBound(arr, 2)
   
7.         For j = 1 To UBound(arr)
   
8.             If Len(arr(j, i)) > 0 Then
   
9.                 tgt = tgt + 1
   
10.                 ReDim Preserve brr(1 To 2, 1 To tgt)
    
11.                 If j = 1 Then
    
12.                     brr(1, tgt) = CStr(arr(j, i))
    
13.                     brr(2, tgt) = "/"
    
14.                 Else
    
15.                     brr(1, tgt) = CStr(brr(1, tgt - 1))
    
16.                     brr(2, tgt) = CStr(arr(j, i))
    
17.                 End If
    
18.             End If
    
19.         Next j
    
20.     Next i
    
21.     Sheet3.UsedRange.ClearContents
    
22.     Sheet3.Range("A1").Resize(UBound(brr, 2), UBound(brr)) = WorksheetFunction.Transpose(brr)
    
23. End Sub

复制代码

sxbjzjf110

参与一下，行列转换

深耕基层

谢谢大家！！！