通过空白将列转置为行

时间:2017-07-18 23:41:57

标签: excel vba excel-vba transpose

我需要将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)无效,因为有一行数据。这有解决方案吗?

1 个答案:

答案 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