Excel将值从不同的行交换到不同的列

我正在寻找一种方法/makro，它允许我使用不同行（1列）的值，以1行显示，但列数不同，如： 旧的：

新的：

因为我必须为大量的数据做这件事，所以makro或类似的东西将是一个很大的帮助

Br

请尝试此代码

Sub Test()
Dim ws          As Worksheet
Dim arr         As Variant

Set ws = ThisWorkbook.Worksheets("Sheet1")
arr = Application.Transpose(ws.Range("A1:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value)

ws.Range("B1").Resize(, UBound(arr)).Value = arr
End Sub

根据T.M的解决方案，这里有一个简短的版本

Sub Transpose_By_ActiveCell_As_Start()
If Not ActiveCell.Parent.Name = "Sheet1" Then Exit Sub

Const nROWS     As Long = 29
Dim arr         As Variant

arr = Application.Transpose(ActiveCell.Resize(nROWS).Value)
ActiveCell.Offset(0, 1).Resize(, nROWS).Value = arr
End Sub

---

您可以将

PasteSpecial

与

Transpose:=True

一起使用

代码

---

作为@Yasserkalil有效答案的附录，以及对您在上述评论中提出的其他问题的回复：

“是否可以将要使用的最大行数设置为X（如仅读取29行并将其写入一行）和标记单元格的位置（我标记A201，它使用A201到A229并将其写入B201、C201等）？”

► 您可以轻松地将max rows定义为常量，并按如下方式使用它：

Sub Test2()
' Do nothing if you aren't in wanted sheet
  If Not ActiveCell.Parent.Name = "Sheet1" Then Exit Sub

  Const NROWS     As Long = 29
  Dim arr         As Variant
  Dim nStart      As Long
  Dim sRng        As String
' Define data range as string
  nStart = ActiveCell.Row
  sRng = ActiveCell.Address & ":" & Replace(ActiveCell.Address, nStart, nStart + NROWS - 1)
' get transposed data
  arr = Application.Transpose(Range(sRng).Value)
' write transposed data to new defined range
  ActiveCell.Offset(0, 1).Resize(, NROWS).Value = arr
End Sub

---

又快又聪明又矮：-）嘿，太棒了，泰！有没有可能将要使用的最大行数设置为X（比如只读取29行并将其写入一行）和标记单元格的位置（我标记A201，它使用A201到A229并将其写入B201、C201等）？@HalbeSuppe补充了一个答案，作为Yasserkalil的精细解决方案的补充。Ty@T.M.，这正是我所需要的，我只是按我需要的方式更改了偏移量。太好了，非常感谢大家：）

Sub Transpose_By_ActiveCell_As_Start()
If Not ActiveCell.Parent.Name = "Sheet1" Then Exit Sub

Const nROWS     As Long = 29
Dim arr         As Variant

arr = Application.Transpose(ActiveCell.Resize(nROWS).Value)
ActiveCell.Offset(0, 1).Resize(, nROWS).Value = arr
End Sub

Option Explicit

Sub TransposeRow()

Dim Sht          As Worksheet

Set Sht = ThisWorkbook.Worksheets("Sheet1") ' modify "Sheet1" to your sheet's name
With Sht
    .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Copy

    .Range("B1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
End With

End Sub

Sub Test2()
' Do nothing if you aren't in wanted sheet
  If Not ActiveCell.Parent.Name = "Sheet1" Then Exit Sub

  Const NROWS     As Long = 29
  Dim arr         As Variant
  Dim nStart      As Long
  Dim sRng        As String
' Define data range as string
  nStart = ActiveCell.Row
  sRng = ActiveCell.Address & ":" & Replace(ActiveCell.Address, nStart, nStart + NROWS - 1)
' get transposed data
  arr = Application.Transpose(Range(sRng).Value)
' write transposed data to new defined range
  ActiveCell.Offset(0, 1).Resize(, NROWS).Value = arr
End Sub