如图转置数据列

shl7184894

如图转置数据列

deadzlq

PQ参考解法

1055751654

Sub s()
Dim arr As Range, brr(1 To 10000, 1 To 3), i, ii, n
Set arr = Range("a2:g" & [g65536].End(3).Row)'这个不严谨，G列下面没东东就完蛋了，得改成[a1].UsedRange才行
    r = [g65536].End(3).Row’这个得改成 [A65536].End(3).Row
    For i = 1 To r
    y = i * 2
    For ii = 3 To 7
        If arr(y, ii) <> "" Then
            n = n + 1
        brr(n, 1) = "'" & arr(y, 1)
        brr(n, 2) = arr(y - 1, ii)
        brr(n, 3) = arr(y, ii)
        End If
    Next
Next
[m2].Resize(UBound(brr), 3) = brr

End Sub