在 Excel 中堆叠列块

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