Excel VBA循环：将列重新整形成表格

我有一段时间没有使用VBA，所以很生锈…我有一些logging垂直存储（在一个单一的列），我想用VBA并排堆放（到表）。

我对这将如何stream动的一般想法：

1. 从第一个范围开始
2. 复制数据
3. 将数据粘贴到输出页面的单元格B3（名为Sheet2）
4. 循环回到先前的范围，并偏移51行
5. 复制数据
6. 将数据粘贴到输出页面的单元格C3中（每次偏移1列）

我到目前为止的尝试：

Sub Macro1() FiftyOne = 51 ' Offset by 51 rows for every chunk StartRange = "L262:L303" ' Start at this range of data to copy, each chunk is identical in size OutputRange = B3 ' Paste in output at B3, but need to offset by one column each time Range(StartRange).Offset(FiftyOne, 0).Select Selection.Copy Sheets("Sheet2").Select Range("B3").Offset(0, 1).Select ActiveSheet.Paste End Sub 

我知道这是一个相当蹩脚的尝试来解决这个stream程，但我真的很困难如何循环这一点。 我将不胜感激一些build议如何做到这一点，或更好的方法来处理一般stream程。

---

接受Wolfie的回答后编辑 ：

我想通过从C258获取值并循环（以前类似的方式）51行来分配列标题，以粘贴到sheet2（B2，C2，…）的第2行中。

这是我目前的尝试：

 Sub NameToTable() ' Assign first block to range, using easily changable parameters ' Remember to "Dim" all of your variables, using colon for line continuation Dim blocksize As Long: blocksize = 51 Dim firstrow As Long: firstrow = 258 Dim rng As Range Set rng = ThisWorkbook.Sheets("Sheet1").Range("C" & firstrow & blocksize - 1) ' tablestart is the upper left corner of the "pasted" table Dim tablestart As Range: Set tablestart = ThisWorkbook.Sheets("Sheet2").Range("B2") Dim i As Long ' Looping variable i Dim nblocks As Long: nblocks = 10 ' We're going to loop nblocks number of times For i = 0 To nblocks - 1 ' Do the actual value copying, using Resize to set the number of rows ' and using Offset to move down the original values and along the "pasted" columns tablestart.Offset(0, i).Resize(blocksize, 1).Value = _ rng.Offset(blocksize * i, 0).Value Next i End Sub 

Answer 1

你的逻辑看起来没问题，这段代码会创build一个51 xn表格，在每一列的51个单元格中排列每个垂直块。

请注意，分配.Value比复制和粘贴要快得多，如果您还需要格式，则可以复制/粘贴或类似地设置格式属性相等。

 Sub ColumnToTable() ' Assign first block to range, using easily changable parameters ' Remember to "Dim" all of your variables, using colon for line continuation Dim blocksize As Long: blocksize = 51 Dim firstrow As Long: firstrow = 262 Dim rng As Range Set rng = ThisWorkbook.Sheets("Sheet1").Range("L" & firstrow & ":L" & firstrow + blocksize - 1) ' tablestart is the upper left corner of the "pasted" table Dim tablestart As Range: Set tablestart = ThisWorkbook.Sheets("Sheet2").Range("B3") Dim i As Long ' Looping variable i Dim nblocks As Long: nblocks = 10 ' We're going to loop nblocks number of times For i = 0 To nblocks - 1 ' Do the actual value copying, using Resize to set the number of rows ' and using Offset to move down the original values and along the "pasted" columns tablestart.Offset(0, i).Resize(blocksize, 1).Value = _ rng.Offset(blocksize * i, 0).Value Next i End Sub 

设置nblocks值以满足您的需求，这是您的输出表中的结果列的数量。 您可以通过了解原始列中的行数来dynamic获取它。 或者你可以使用一些逻辑，小心确保它最终会退出！

 Dim i As Long: i = 0 Do While rng.Offset(blocksize*i, 0).Cells(1).Value <> "" tablestart.Offset(0, i).Resize(blocksize, 1).Value = rng.Offset(blocksize * i, 0).Value i = i + 1 Loop 

---

编辑：要得到您的列标题，请记住列标题只有1个单元格，所以：

 ' Change this: Set rng = ThisWorkbook.Sheets("Sheet1").Range("C" & firstrow & blocksize - 1) ' To this: Set rng = ThisWorkbook.Sheets("Sheet1").Range("C" & firstrow) 

提示： +用于添加数字值，而&用于拼接刺激。

现在当你循环时，你不需要Resize ，因为你只给1个单元格赋值1个单元格的值。 结果子：

 Sub NameToTable() Dim blocksize As Long: blocksize = 51 Dim firstrow As Long: firstrow = 258 Dim rng As Range Set rng = ThisWorkbook.Sheets("Sheet1").Range("C" & firstrow) Dim tablestart As Range: Set tablestart = ThisWorkbook.Sheets("Sheet2").Range("B2") Dim i As Long: i = 0 Do While rng.Offset(blocksize*i, 0).Value <> "" tablestart.Offset(0, i).Value = rng.Offset(blocksize * i, 0).Value i = i + 1 Loop End Sub 

Answer 2

在Excel中处理工作表时，每次引用它们会增加开销并降低代码速度，所以要将电子表格中的所有信息都放到数组中，然后使用Application.Transpose进行转置。

然后，您可以使用“resize”，以确保您的目标范围是相同的大小，并设置值。

 Sub CopyAndTransRange(src As Range, dest As Range) Dim arr As Variant 'Needs to be a variant to take cell values arr = Application.Transpose(src.Value) 'Set to array of values On Error GoTo eh1dim 'Capture error from vertical 1D range dest.Resize( _ UBound(arr, 1) - LBound(arr, 1) + 1, _ UBound(arr, 2) - LBound(arr, 2) + 1 _ ) = arr 'Set destination to array Exit Sub eh1dim: dest.Resize( _ 1, _ UBound(arr) - LBound(arr) + 1 _ ) = arr 'Set row to 1D array End Sub 

请注意，Application.Transpose会在奇怪的情况下遇到一些数组，如给定数组中的string中有超过255个字符，那么您可以编写自己的Transpose函数来为您翻转数组。

编辑：

当你提供一个垂直的一维范围并转置它时，VBA会将它转换为一维数组，我已经重写，所以在发生这种情况时会捕获错误，然后进行相应的调整。

Answer 3

只是做了这个例子，其值为1到7填充在列A的前7行。该代码有效地循环通过每个值，并进行水平转置，所以所有的值在一行（1）。

 Dim rng As Range Dim crng As Range Static value As Integer Set rng = ActiveSheet.Range("A1", Range("A1").End(xlDown)) For Each crng In rng.Cells ActiveSheet.Range("A1").Offset(0, value).value = crng.value If value <> 0 Then crng.value = "" End If value = value + 1 Next crng 

首先我们抓住所需的范围，然后遍历每个单元格。 然后使用offset方法和递增整数，我们可以将它们的值水平地分配给一行。

值得注意的是，当试图垂直和水平转置时，这将工作。 关键是offset(column, row) 。

只要调整你放置递增整数的位置。

希望这可以帮助。