使用 VBA 将 Excel 数据从列复制到行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/17596226/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Copy Excel data from columns to rows with VBA
提问by Rawr
I have a little experience with VBA, and I would really appreciate any help with this issue. In a basic sense, I need to convert 2 columns of data in sheet 1 to rows of data in sheet 2.
我对 VBA 有一点经验，我非常感谢您对这个问题的任何帮助。从基本意义上讲，我需要将工作表 1 中的 2 列数据转换为工作表 2 中的数据行。
It currently looks like this in Excel:
它目前在 Excel 中看起来像这样：
And I need it to look like this:
我需要它看起来像这样：
I've already written the code to transfer the headings over to sheet 2, and it works fine. I'm just having issues with transferring the actual values in the correct format. Right now, the body of my code is
我已经编写了将标题转移到工作表 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
continued on and on. However, this really won't work, as the actual document I'm working on has tens of thousands of data points. I know there's a way to automate this process, but everything I've tried has either done nothing or given an error 1004.
继续下去。但是，这真的行不通，因为我正在处理的实际文档有数万个数据点。我知道有一种方法可以使这个过程自动化，但是我尝试过的所有方法要么什么也没做，要么给出了错误 1004。
Any help with this would be greatly appreciated!!
对此的任何帮助将不胜感激！！
Edit: There are hundreds of little sections of data, each 18 rows long (1 row for the frame #, 1 row for the time, and 1 row for each of the 16 channels). I'm trying to get it into a loop with a step size of 18. Is that possible? I'm fine with loops, but I've never done a loop with copying and pasting cell values
编辑：有数百个小数据段，每段长 18 行（帧# 1 行，时间 1 行，16 个通道中的每个通道 1 行）。我试图让它进入一个步长为 18 的循环。这可能吗？我对循环很好，但我从来没有做过复制和粘贴单元格值的循环
采纳答案by Paul Renton
This method leverages loops and arrays to transfer the data. It isn't the most dynamic method but it gets the job done. All the loops use existing constants, so if your data set changes you can adjust the constants and it should run just fine. Make sure to adjust the worksheet names to match the names you are using in your excel document. In effect, what this is doing is loading your data into an array and transposing it onto another worksheet.
此方法利用循环和数组来传输数据。这不是最动态的方法，但它可以完成工作。所有的循环都使用现有的常量，所以如果你的数据集发生变化，你可以调整常量，它应该运行得很好。确保调整工作表名称以匹配您在 Excel 文档中使用的名称。实际上，这样做是将您的数据加载到一个数组中并将其转置到另一个工作表上。
If your data set sizes change quite a bit, you will want to include some logic to adjust the loop variables and array size declarations. If this is the case, let me know and I'll figure out how to do that and post an edit.
如果您的数据集大小变化很大，您将需要包含一些逻辑来调整循环变量和数组大小声明。如果是这种情况，请告诉我，我会弄清楚如何做到这一点并发布编辑。
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-> I think this is what you are looking for after reading your edits
编辑-> 我认为这就是你在阅读你的编辑后正在寻找的
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
Now the key to this working is knowing how many groups of data you are dealing with after the data dump. You either need to include logic for detecting that or adjust the constant called numberDataGroups to reflect how many groups you have. Note: I leveraged a similar technique for traversing arrays that have their data stored in Row Major format.
现在，这项工作的关键是知道在数据转储后您要处理多少组数据。您要么需要包含用于检测的逻辑，要么调整名为 numberDataGroups 的常量以反映您拥有的组数。注意：我利用了一种类似的技术来遍历数据以 Row Major 格式存储的数组。
回答by Eldar Agalarov
Try this code:
试试这个代码：
Dim X() As Variant
Dim Y() As Variant
X = ActiveSheet.Range("YourRange").Value
Y = Application.WorksheetFunction.Transpose(X)
Also check out this link: Transpose a range in VBA
另请查看此链接：Transpose a range in VBA
回答by d-stroyer
This is a way to do it using a loop, here illustrated with a step of 2
这是一种使用循环的方法，此处以步骤 2 进行说明
Notice that you have to specify the OutRange precisely the correct size (here NTR2 is the 10001's cell of the 2nd row).
请注意，您必须准确指定正确的大小（此处 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
回答by Sumit Saha
'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
回答by Patrick Honorez
Use Copy, then Paste Special+Transpose to turn your columns into rows:Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
使用复制，然后粘贴特殊+转置将您的列变成行：Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
回答by d-stroyer
Try this:
尝试这个：
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
