VBA /宏置简单的表

Question

我想请教一下VBA，因为我在VBA编写新，你可以建议我下面的问题：

我有表像

Source

我要转的所有数据变成：

感谢您的建议。一帆风顺

Answer 1

请试试这个...

'************************************************************************ 
'The code will work like this 
'1) UnPivot the data on Sheet1 
'2) Insert a New Sheet called Tranposed if not available in the workbook 
'3) Place the output i.e. UnPivoted data on the Transposed Sheet. 
'************************************************************************ 

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

    'Assuming your raw 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("A2").Resize(UBound(y), 2).Value = y 
    wsDest.Range("A1").CurrentRegion.Borders.Color = vbBlack 
    MsgBox "Data Transposed Successfully.", vbInformation, "Done!" 
End Sub