Excel 将所有列与 VBA 合并

Excel merge all columns with VBA

我使用的是 MS Excel 2010,我有一个 excel sheet,没有宏也没有公式,一切都是原始格式。

sheet 包含很多列和行(A 列到 WC 列),如下图所示。

~ represents split view between columns
# represents row number


          | A | B | C | ~ | AA | AB | ~ | WC |
     -----------------------------------------
    |#   1| x | x | x | ~ |  x |  x | ~ |  x |
    |#  10| x | x | x | ~ |  x |  x | ~ |  x |
    |# 100| x | x | x | ~ |  x |  x | ~ |  x |
    |#1000| x | x | x | ~ |  x |  x | ~ |  x |
    |#2000| x | x | x | ~ |  x |  x | ~ |  x |
    |#3000| x | x | x | ~ |  x |  x | ~ |  x |

我想(合并)将所有列从 "B" 移动到 "WC" 到列 "A" 的最后一行。

列 "A" 的内容可能不会被丢弃。 "B" 到 "WC" 的每一列都必须插入到 "A"

列的最后一行下方

示例(之后):

          | A | B | C | ~ | AA | AB | ~ | WC |
     -----------------------------------------
    |#   1| x |   |   | ~ |    |    | ~ |    |
    |#  10| x |   |   | ~ |    |    | ~ |    |
    |# 100| x |   |   | ~ |    |    | ~ |    |
    |#1000| x |   |   | ~ |    |    | ~ |    |
    |#2000| x |   |   | ~ |    |    | ~ |    |
    |#3000| x |   |   | ~ |    |    | ~ |    |
    |#4000| x |   |   | ~ |    |    | ~ |    |
    |#5000| x |   |   | ~ |    |    | ~ |    |
    |#6000| x |   |   | ~ |    |    | ~ |    |
    |#7000| x |   |   | ~ |    |    | ~ |    |
    |#8000| x |   |   | ~ |    |    | ~ |    |
    |#9999| x |   |   | ~ |    |    | ~ |    |

我的专栏故意不包含专栏 headers (column-names).

实现此目标的最佳方法是什么?

我确实找到了这个帖子: How to merge rows in a column into one cell in excel? -- 老实说,我现在真的不明白如何在我的 Sheet 上申请。其次,该主题是 3 年前创建的,并且在 2 个多月前处于活跃状态。所以我决定在这里问一个新问题。

我做了研究,发现了很多不同类型的合并方式:

> Some recommend CONCATENATE-formula 
> Some recommend Transpose formula
> Some recommend macro Some use a VBA script
> Some recommend JOIN function
> Some recommend payed solutions like Kutools

考虑到我所处情况的列数,我认为 VBA 脚本解决方案最为合适。如果有人可以提供反馈,我会给 +1

谢谢!

更新:

(its now late here) i'm scripting a new macro from scratch that basically does
1. select column B
2. select until top until last row in column B
3. copy contents
4. select column A
5. navigate to last row in column A
6. go 1 cell down
7. paste contents of column B
8. select column B
9. DELETE column B
10. Repeat 600 times :-)

更新 2:

这是我的 self-made 没有 for-loop 的宏:

    Sub CopyColumnBtoAandDeleteB()
Worksheets("Sheet1").Activate
Range("B1", Range("B1").End(xlDown)).Select
Range("B1", Range("B1").End(xlDown)).Copy
Range("A1").End(xlDown).Select
Selection.Offset(1, 0).PasteSpecial xlPasteValues
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
End Sub

糟糕。出于某种原因,这在 305707 条记录后停止,这是因为我的 sheet 包含许多活动单元格,导致范围内有额外的银行单元格并溢出 A 列中的行,超出了 Excel 的内存限制。那是另一个问题了。

这是一种俄罗斯方块的方法。它可能不是最快的,但关闭屏幕更新和事件处理应该会加快速度。如果涉及公式,计算模式也可以设置为xlCalculationManual

Sub from_A_to_WC()
    Dim c As Long, grp As Long, cols As Long
    apps_Toggle
    With Sheets("Sheet3")
        grp = .Cells(Rows.Count, 1).End(xlUp).Row
        cols = .Columns("WC").Column
        For c = 2 To cols
            .Cells(1, 2).Resize(grp, cols).Insert Shift:=xlDown
            .Cells((c - 1) * grp, 1).Offset(1, 0).Resize(grp, 1).Delete Shift:=xlToLeft
        Next c
    End With
    apps_Toggle
End Sub

Sub apps_Toggle()
    Application.ScreenUpdating = Not Application.ScreenUpdating
    Application.EnableEvents = Not Application.EnableEvents
End Sub

更改您需要的第三行中的工作表名称,如果与您的数据不匹配,则调整第五行中的边界列(当前为 WC 列)。

如果工作表上有除相关数据之外的任何其他内容,这确实不是一个合适的解决方案,因为它会大大取代任何未移动的内容。

这是一种使用数组来加快速度的方法。

Option Base 1 ' Don't omit this line!
Sub ArrayMan()

    Dim u As Long
    Dim v As Long
    Dim k As Long: k = 1
    Dim z As Long

    InArray = Range("A1:WC400").Value 'Change to your actual dimensions

    u = UBound(InArray, 1)
    v = UBound(InArray, 2)
    z = u * v

    Dim OutArray() As Variant
    ReDim OutArray(z)

    For i = 1 To v 'columns
        For j = 1 To u 'rows
            OutArray(k) = InArray(j, i)
            k = k + 1
        Next
    Next
    Range("A1:A" & z) = WorksheetFunction.Transpose(OutArray)

End Sub

这个微小的宏代码对我有用:

    Sub CopyColumnBtoAandDeleteB()
Worksheets("Sheet1").Activate
Range("B1", Range("B1").End(xlDown)).Select
Range("B1", Range("B1").End(xlDown)).Copy
Range("A1").End(xlDown).Select
Selection.Offset(1, 0).PasteSpecial xlPasteValues
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
End Sub

不幸的是,由于 MS Excel 2010 的限制,它在 305707 条记录后停止,我建议如果其他人使用它,你应该去掉几列,因为 255 是很多列(即使用于 MS Access)。您还应该在安全模式下 运行 MS Excel。