Excel，试图复制，转置X个单元格
我有一个列表（垂直）的成员有61个数据字段。 我需要cooy /转置每个成员到另一个表。
样本数据：
Name: Last Name: Address: Membership Date: Maiden Name: ... 61 items 我得到的文件重复每个成员的数据字段标题，所以文件是2列宽50k长
我想复制列b到另一个工作表。
所以这就是我所拥有的，我不知道下一步该去哪里。
Sub CopyTranspose() Dim rng As Range Dim i As Long Set rng = ThisWorkbook.ActiveSheet.Range("B1:B51000") With rng ' Loop through all cells of the range For i = 1 To 51000 Step 1 'Select member data fields Range("B2:B61").Select ' Copy and transpose Selection.Copy Sheets("Sheet1").Select Range("A2").Select Range("A2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Next i End With End Sub
我知道这是不对的，我知道我需要为每个迭代添加61，当粘贴到最后一个空行。 我假设我为I-61 + x迭代次数添加了另一个variables。 然后我在粘贴面上做一些事情，跳到最后一个空单元格？
感谢您的帮助。
这应该工作假设你想每个数据点作为一个列和每个人的新行？
lRow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row For i = 1 To lRow Step 61 iStart = i iEnd = i + 60 Sheets("Data").Range("B" & iStart & ":B" & iEnd).Copy Sheets("Sheet1").Range("A" & Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True Next i
使用数组转换数据比使用复制/粘贴要快得多 。 鉴于你的数据集的大小，我认为一个快速的解决scheme是可取的…
' Get last row in copy-from sheet Dim lastRow as Long lastRow = Sheets("DataSheet").Range("A" & Rows.Count).End(xlUp).Row ' Loop down that sheet, copying blocks of 61 rows Dim i as Long Dim dataArray as Variant For i = 1 To lastRow Step 61 ' Assign data to an array dataArray = Sheets("DataSheet").Range("B" & i & ":B" & i + 60) ' Stick the values of that transposed array into the summary sheet With Sheets("TransposedSheet") .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1).value = Application.Transpose(dataArray) End With Next i
我提到速度。 为了比较，我实现了我的方法，acsql的复制/粘贴方法，以及Application.ScreenUpdating = False的复制/粘贴方法。 最后一个选项是一个众所周知的加速macros的方法。 列B中4000行的单个数字的结果：
- 数组方法：0.01171875 s
- 复制和粘贴方法（屏幕更新为真）0.7890625秒
- 复制和粘贴方法（屏幕更新错误）0.3671875 s
所以使用数组 ！