如何将每7列移动到下一个空行？

Question

我有从A1到BOO66262的数据，无论行数多少，我都需要将所有内容都放在七列中。我目前有：

     | A | B | C | D | E | F | G | H | I | J | K | L | M | N | ... | BOO
1    | x | x | x | x | x | x | x | x | x | x | x | x | x | x | ... | x
...  | . | . | . | . | . | . | . | . | . | . | . | . | . | . | ... | .
66262| x | x | x | x | x | x | x | x | x | x | x | x | x | x | ... | x

我需要工作表只有七列，如下所示：

    | A | B | C | D | E | F | G
1   | x | x | x | x | x | x | x
... | x | x | x | x | x | x | x
n   | x | x | x | x | x | x | x

每个组有7列，但行数不同。有谁知道如何用VBA做到这一点？

以下是我的电子表格当前外观的截图：

Answer 1

使用 Alt + F11 打开VBE，并将以下内容放入模块代码表中。

Sub play_tetris()
    Dim rws As Long, cls As Long, i As Long
    Dim v As Long, vs As Long, vTMP As Variant, vVALs As Variant

    Application.ScreenUpdating = False

    With Worksheets("Sheet1")
        With .Cells(1, 1).CurrentRegion
            ReDim vVALs(1 To Application.CountA(.Cells) / 7, 1 To 7)
        End With
        For cls = 1 To Range("BOO1").Column Step 7
            rws = .Cells(Rows.Count, cls).End(xlUp).Row
            vTMP = .Cells(1, cls).Resize(rws, 7).Value2
            For v = LBound(vTMP, 1) To UBound(vTMP, 1)
                vs = vs + 1
                For i = 1 To 7
                    vVALs(vs, i) = vTMP(v, i)
                Next i
            Next v
        Next cls
        With .Cells(1, 1).Resize(UBound(vVALs, 1), 7)
            .Value = vVALs
            .Rows(1).Copy
            .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                          SkipBlanks:=False, Transpose:=False
            .Resize(1, Range("BOO1").Column).Offset(0, 7).EntireColumn.Delete
        End With
    End With

    Application.ScreenUpdating = True

End Sub

如果您不使用Sheet1，请在第四行调整工作表.Name property。点击 Alt + Q 返回工作表，然后 Alt + F8 打开宏对话框并运行宏。