我需要将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)
无效,因为有一行数据。这有解决方案吗?
答案 0 :(得分:0)
你想要实现的目标可以通过这个来实现......
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