Question

我有一段时间没有使用VBA所以非常生疏......我所拥有的是一些垂直存储的记录（在一列中）我希望使用VBA将它们并排堆叠（放入表格中）。

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

从第一个范围开始
复制数据
将数据粘贴到输出页面的单元格B3中（仅命名为Sheet2）
循环回到上一个范围并偏移51行
复制数据
将数据粘贴到输出页面的单元格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

我知道这是一个相当蹩脚的尝试来解决这个问题，但我真的在努力解决这个问题。我会很感激有关如何做到这一点的一些建议，或者对一般流程采取更好的方法。

编辑：

我想指定列标题，方法是从C258获取值并循环（以与之前类似的方式）一次51行，以粘贴到sheet2的第2行（B2，C2，...）。

这是我目前的尝试：

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

您的逻辑似乎没问题，此代码将创建一个51 x n表，在其自己的列中排列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值以满足您的需要，这是输出表中结果列的数量。您可以通过了解原始列中的行数来动态获取它。或者您可以使用一些while逻辑，小心确保它最终会退出！

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个单元格的值分配给另一个单元格。结果子：

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

刚刚在A列的前7行填充了这个值为1到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)。

只需调整递增整数的位置即可。

希望这会有所帮助。

Answer 3

在excel中处理工作表时，每次引用它们都会增加开销并减慢代码速度，您要做的就是将电子表格中的所有信息都放入数组中，然后使用Application.Transpose进行转置它适合你。

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

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会在奇怪的情况下使用某些数组，例如，如果给定数组中的字符串中有超过255个字符，那么您可以编写自己的Transpose函数来为您翻转数组。

编辑：

当您输入垂直的1维范围并将其转置时，VBA会将其转换为1维数组，我已经重写，以便在发生这种情况时捕获错误，然后相应地进行调整。

Excel VBA循环：将列重塑为表

3 个答案: