转置包含1500行和13列的Excel表

Question

所以我在Excel中有这个表，如下所示：

该表有14列和1500行描述汽车（为简单起见）销售。

现在，我想要的是将表转换成这样：

我知道有一个转置公式（我用它来构建上面的第二个表），但我显然不能对表中所有1500行中的每一个都执行此操作。

任何人都可以帮我解决最有效的方法吗？欢迎使用VBA代码或宏。

非常感谢！

Answer 1

尝试这样的事情

 Sub UnPivotData()
 Dim wsSource As Worksheet, wsDest As Worksheet
 Dim x, y, i As Long, j As Long, n As Long

'Assuming data is on a sheet called "Sheet1", change it if required
Set wsSource = Sheets("Sheet1")

x = wsSource.Cells(1).CurrentRegion.Value
ReDim y(1 To UBound(x, 1) * UBound(x, 2), 1 To 2)

For i = 2 To UBound(x, 1)
    For j = 2 To UBound(x, 2)
        If x(i, j) <> "" Then
            n = n + 1
            y(n, 1) = x(i, 1)
            y(n, 2) = x(i, j)
        End If
    Next
Next

On Error Resume Next
Set wsDest = Sheets("Transposed")
wsDest.Cells.Clear
On Error GoTo 0

If wsDest Is Nothing Then
    Sheets.Add(after:=wsSource).Name = "Transposed"
    Set wsDest = ActiveSheet
End If
wsDest.Range("A1:B1").Value = Array("Number", "Deatils")
wsDest.Range("A1").Resize(UBound(y), 550).Value = y
wsDest.Range("A1").CurrentRegion.Borders.Color = vbBlack
MsgBox "Data Transposed Successfully.", vbInformation, "Done!"
End Sub