答案 0 :(得分: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