Excel VBA 利用数组行列转换

Sub 表格行列转换()

Dim i, j
Dim Arr(), Brr()

Application.ScreenUpdating = False

Arr = Range("A2:Af12")

ReDim Brr(1 To 352, 1 To 4) 'arr行*列11*32=352

For i = 2 To 11

    For j = 2 To 32
    
    If Arr(i, j) <> "" And Arr(1, j) <> "" And Arr(i, 1) <> "" Then
    
    k = k + 1
    
    Brr(k, 1) = Arr(i, 1)
    
    Brr(k, 2) = Arr(1, j)
    
    Brr(k, 3) = Arr(i, j)
    
    Brr(k, 4) = ActiveSheet.Name '增加一列表名
    
    End If
    
    Next

Next

Range("ag2").Resize(k, UBound(Brr, 2)) = Brr

Application.ScreenUpdating = True