將列轉爲空白

Question

我需要將列B中的垂直數據轉置爲水平數據。

我的表看起來像這樣：

85.98 |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
97.62 |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
100.00 |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
100.00 |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
     |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
89.81 |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
78.70 |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
100.00 |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
     |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
94.32 |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
     |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
     |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
     |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
90.91 |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
    0.00 |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
88.54 |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
76.96 |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
94.32 |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
89.11 |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 

我希望它看起來像這樣：

85.98 | 97.62 | 100.00 | 100.00 |  |  | 
-------|--------|--------|--------|--------|--------| 
89.81 | 78.70 | 100.00 |  |  |  | 
-------|--------|--------|--------|--------|--------| 
94.32 |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
     |  |  |  |  |  | 
-------|--------|--------|--------|--------|--------| 
90.91 | 0.00 | 88.54 | 76.96 | 94.32 | 89.11 | 

我使用下面的代碼：

Sub Transpose() 
    Dim t As Range, u As Range 
    c = ActiveCell.Column 
    fr = ActiveCell.Row 
    lr = Cells(Rows.Count, c).End(xlUp).Row 
    r = fr 
    Do 
     Set t = Cells(r, c) 
     Set u = t.End(xlDown) 
     Range(t, u).Copy 
     t.Offset(, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True 
     r = u.End(xlDown).Row 
    Loop While r < lr 
    Application.CutCopyMode = False 
    End Sub 

問題是.End(xlDown)不起作用，因爲有單行數據。有沒有解決方案？

Answer 1

什麼你正在努力實現可以用這個來完成...

Sub TransposeData() 
Dim lr As Long 
Dim rng As Range 
Application.ScreenUpdating = False 
lr = Cells(Rows.Count, 3).End(xlUp).Row 
'Change the first row as required. C1 in the below line assumes that the data start from Row1 in Column C. 
For Each rng In Range("C1:C" & lr).SpecialCells(xlCellTypeConstants, 1).Areas 
    rng.Copy 
    rng.Cells(1).Offset(0, 1).PasteSpecial xlPasteAll, Transpose:=True 
Next rng 
Application.CutCopyMode = 0 
Application.ScreenUpdating = True 
End Sub