使用 VBA 将 Excel 数据从列复制到行

Question

我对 VBA 有一点经验，如果能在此问题上提供任何帮助，我将不胜感激。在基本意义上，我需要将工作表 1 中的 2 列数据转换为工作表 2 中的数据行。

目前在 Excel 中是这样的：

我需要它看起来像这样：

我已经编写了将标题转移到工作表 2 的代码，并且工作正常。我只是在以正确格式传输实际值时遇到问题。现在，我的代码主体是

ws.Range("B3").Copy
ws2.Range("C2").PasteSpecial xlPasteValues

ws.Range("B4").Copy
ws2.Range("D2").PasteSpecial xlPasteValues

ws.Range("B5").Copy
ws2.Range("E2").PasteSpecial xlPasteValues

ws.Range("B6").Copy
ws2.Range("F2").PasteSpecial xlPasteValues

继续。但是，这真的行不通，因为我正在处理的实际文档有数万个数据点。我知道有一种方法可以自动执行此过程，但我尝试过的所有操作要么什么也没做，要么给出错误 1004。

对此的任何帮助将不胜感激！

编辑：有数百个小数据部分，每个 18 行长（1 行用于帧#，1 行用于时间，1 行用于 16 个通道中的每一个）。我试图让它进入一个步长为 18 的循环。这可能吗？我对循环很好，但我从来没有做过复制和粘贴单元格值的循环

Answer 1

试试这个代码：

Dim X() As Variant
Dim Y() As Variant
X = ActiveSheet.Range("YourRange").Value
Y = Application.WorksheetFunction.Transpose(X)

另请查看此链接：Transpose a range in VBA

Answer 2

此方法利用循环和数组来传输数据。这不是最动态的方法，但它可以完成工作。所有循环都使用现有常量，因此如果您的数据集发生更改，您可以调整常量，它应该可以正常运行。确保调整工作表名称以匹配您在 Excel 文档中使用的名称。实际上，这是将数据加载到数组中并将其转置到另一个工作表中。

如果您的数据集大小变化很大，您将需要包含一些逻辑来调整循环变量和数组大小声明。如果是这种情况，请告诉我，我会弄清楚如何执行此操作并发布编辑。

Sub moveTimeData()

Set source = ThisWorkbook.Sheets("RawData")
Set dest = ThisWorkbook.Sheets("TransposeSheet")

Const dataSetSize = 15

Const row15Start = 3
Const row15End = 18
Const row30Start = 21
Const row30End = 36

Const colStart = 2

Const destColStart = 2
Const dest15RowStart = 2
Const dest30RowStart = 3

Dim time15Array() As Integer
Dim time30Array() As Integer
ReDim time15Array(0 To dataSetSize)
ReDim time30Array(0 To dataSetSize)

Dim X As Integer
Dim Y As Integer
Dim c As Integer
c = 0

For X = row15Start To row15End
    time15Array(c) = source.Cells(X, colStart).Value
    c = c + 1
Next X

c = 0
For X = row30Start To row30End
    time30Array(c) = source.Cells(X, colStart).Value
    c = c + 1
Next X

For X = 0 To dataSetSize
    dest.Cells(dest15RowStart, X + destColStart).Value = time15Array(X)
Next X

For X = 0 To dataSetSize
    dest.Cells(dest30RowStart, X + destColStart).Value = time30Array(X)
Next X

End Sub

EDIT->我认为这是您在阅读您的编辑后正在寻找的内容

Sub moveTimeData()

Set source = ThisWorkbook.Sheets("RawData")
Set dest = ThisWorkbook.Sheets("TransposeSheet")

Const numberDataGroups = 4
Const dataSetSize = 15
Const stepSize = 18

Const sourceRowStart = 3

Const sourceColStart = 2

Const destColStart = 2
Const destRowStart = 2



Dim X As Integer
Dim Y As Integer
Dim currentRow As Integer
currentRow = destRowStart



For X = 0 To numberDataGroups
    For Y = 0 To dataSetSize
        dest.Cells(currentRow, Y + destColStart).Value = source.Cells((X * stepSize) + (Y    + sourceRowStart), sourceColStart)
    Next Y
    currentRow = currentRow + 1
Next X


End Sub

现在，这项工作的关键是知道在数据转储后您正在处理多少组数据。您要么需要包含用于检测的逻辑，要么调整名为 numberDataGroups 的常量以反映您拥有的组数。注意：我利用类似的技术来遍历以 Row Major 格式存储数据的数组。

Answer 3

使用复制，然后选择性粘贴+转置将列转换为行：
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True

Answer 4

试试这个：

Sub TansposeRange()
 Dim InRange As Range
 Dim OutRange As Range
 Dim i As Long

 Set InRange = Sheet1.Range("B3:B10002")
 Set OutRange = Sheet2.Range("C2")

 InRange.Worksheet.Activate
 InRange.Select
 Selection.Copy

 OutRange.Worksheet.Activate
 OutRange.Select

 Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True

End Sub

Answer 5

这是一种使用循环的方法，此处以 2 步进行说明

请注意，您必须准确地指定 OutRange 正确的大小（这里 NTR2 是第 2 行的 10001 的单元格）。

Sub TansposeRange()
 Dim InRange As Range
 Dim OutRange As Range
 Dim i As Long

 Set InRange = Sheet1.Range("B3:B10002")
 Set OutRange = Sheet2.Range("C2:NTR2")

 For i = 1 To 10000 Step 2
  OutRange.Cells(1, i) = InRange.Cells(i, 1)
 Next i

End Sub

Answer 6

    'The following code is working OK
    Sub TansposeRange()
    '
    ' Transpose Macro
    '
    Dim wSht1 As Worksheet
    Dim rng1 As Range
    Dim straddress As String
    Set wSht1 = ActiveSheet

    On Error Resume Next
    Set rng1 = Application.InputBox(Prompt:="Select Columns or Rows to transpose", _
                                   Title:="TRANSPOSE", Type:=8)
    If rng1 Is Nothing Then
        MsgBox ("User cancelled!")
        Exit Sub
    End If
    straddress = InputBox(Prompt:="Full cell Address as Sheet2!A1", _
          Title:="ENTER Full Address", Default:="Sheet1!A1")
    If straddress = vbNullString Then
         MsgBox ("User cancelled!")
         Exit Sub
    End If      

    Application.ScreenUpdating = False
    rng1.Select
    rng1.Copy

    On Error GoTo 0

    'MsgBox straddress
    Range(straddress).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Application.ScreenUpdating = True
    End Sub