Question

我想以十个块的形式堆叠多个列。我看到了这个例子，其中堆叠是由两对完成的：

Stack multiple columns into two colums in pairs of two

尽管如此，我还没有成功地修改它，使列以十个为一组进行堆叠。

原始数据如下所示：

  A  B  C … J   K  L   M ... N T

1 1.1 1.2 1.3 ... 1.10 1.1 1.2 1.3 ... 1.10

2 2.1 2.2 2.3 ... 2.10 2.1 2.2 2.3 ... 2.10

3 3.1 3.2 3.3 ... 3.10 3.1 3.2 3.3 ... 3.10

4 4.1 4.2 4.3 ... 4.10 4.1 4.2 4.3 ... 4.10

5 5.1 5.2 5.3 ... 5.10 5.1 5.2 5.3 ... 5.10

6 6.1 6.2 6.3 ... 6.10 6.1 6.2 6.3 ... 6.10

7 7.1 7.2 7.3 ... 7.10 7.1 7.2 7.3 ... 7.10

8 8.1 8.2 8.3 ... 8.10 8.1 8.2 8.3 ... 8.10

我想得到的是：

A   B   C   …   J

1 1.1 1.2 1.3 ... 1.10

2 2.1 2.2 2.3 ... 2.10

3 3.1 3.2 3.3 ... 3.10

4 4.1 4.2 4.3 ... 4.10

5 5.1 5.2 5.3 ... 5.10

6 6.1 6.2 6.3 ... 6.10

7 7.1 7.2 7.3 ... 7.10

8 8.1 8.2 8.3 ... 8.10

9 1.1 1.2 1.3 ... 1.10

10 2.1 2.2 2.3 ... 2.10

11 3.1 3.2 3.3 ... 3.10

12 4.1 4.2 4.3 ... 4.10

13 5.1 5.2 5.3 ... 5.10

14 6.1 6.2 6.3 ... 6.10

15 7.1 7.2 7.3 ... 7.10

16 8.1 8.2 8.3 ... 8.10

关于如何使用上面提到的宏或另一个宏的任何提示？

Answer 1

尝试使用此代码，因为它只是您尝试复制的一个范围，K：T，您不必在其中执行任何类型的循环。只需直接复制粘贴即可。

Sub MoveData()

    Dim ws      As Worksheet
    Dim lr      As Long
    Dim lc      As Integer

    Set ws = ThisWorkbook.Sheets(1)
    lc = ws.Range("XFD1").End(xlToLeft).Column '' Find the last column

    While lc <> 10 '' stop once it hits Column J
        lr = ws.Cells(1, lc).End(xlDown).Row '' Find the last row for this block of 10
        ws.Range(ws.Cells(1, lc).Offset(, -9), ws.Cells(lr, lc)).Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1) '' Get the entire range for this block of 10, and copy it to the bottom column A
        ws.Range(ws.Cells(1, lc).Offset(, -9), ws.Cells(lr, lc)).ClearContents '' Clear it out
        lc = ws.Range("XFD1").End(xlToLeft).Column '' Get the last column again for the While loop
    Wend

End Sub

在Excel中堆积列的块

1 个答案: