在Excel中堆叠列的块 [英] Stacking blocks of columns in Excel

问题描述

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

将多个列堆叠成两个成对的两个列

尽管如此，我有没有成功地修改它，使得列以十组的形式堆叠。

原始数据如下所示：

  ABC ... JKLM。 .. NT 
  

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

我想要得到的是这样的： / p>

  ABC ... 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

任何提示如何使用上述宏或另一个宏执行此操作？

解决方案

尝试这段代码，因为它只是你要复制的一个范围，K：T，你不应该做任何类型的循环。

  Sub MoveData（）
 
 Dim ws As Worksheet 
 Dim lr As Long 
 Dim lc As Integer 
 
设置ws = ThisWorkbook.Sheets（1）
 lc = ws.Range（XFD1）。End（xlToLeft） .Column''查找最后一列
 
虽然lc<> 10'停止一旦它击中列J 
 lr = ws.Cells（1，lc）.End（xlDown）.Row''找到这个块的最后一行10 
 ws.Range（ws复制ws.Range（A& ws.Rows.Count）.End（xlUp）.Offset（1） ）''获取此块10的整个范围，并将其复制到底部列A 
 ws.Range（ws.Cells（1，lc）.Offset（，-9），ws.Cells（lr ，lc））。ClearContents'清除它
 lc = ws.Range（XFD1）。End（xlToLeft）.Column''再次获取While循环的最后一个列
 Wend 
 
 End Sub 
  

I would like to stack a multiple columns in blocks of ten. I saw this example where the stacking is done by pairs of two:

Stack multiple columns into two colums in pairs of two

Nonetheless, I have not succeeded in modifying it in such a way that columns are stacked in groups of ten.

The original data looks like this:

  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

What I would like to get is this:

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

Any hint on a how to do it with the macro mentioned above or another one?

解决方案

Try this code, since it's just the one range you're trying to copy, K:T, you shouldn't have to do any sort of loops in it. Just a straight copy paste should work.

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中堆叠列的块的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！