Question

我使用的是MS Excel 2010，我有一张没有宏的excel表，没有公式，所有内容都是原始格式。

工作表包含许多列和行（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 |

我想（合并）移动＆＃34; B＆＃34;的所有列到＆＃34; WC＆＃34;列＃34; A＆＃34;的最后一行

栏目内容＆＃34; A＆＃34;不得丢弃。每一栏＆＃34; B＆＃34;到＆＃34; WC＆＃34;必须插入列＆＃34; A＆＃34;

中最后一行的下方

示例（之后）：

          | 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 |   |   | ~ |    |    | ~ |    |

我的专栏故意不包含列标题（列名）。

实现这一目标的最佳方式是什么？

我确实发现了这个帖子： How to merge rows in a column into one cell in excel? - 说实话，我现在还不能真正理解如何在我的工作表上申请。其次，该主题是在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：

这是我没有for循环的自制宏：

    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记录之后停止，这是因为我的工作表包含许多活动单元格，导致范围中的其他库单元格溢出并且超出Excel列中的行超出了Excel的内存限制。这是另一个不同的问题。

Answer 1

这是一种俄罗斯方块的方法。它可能不是最快的，但关闭屏幕更新和事件处理应该加快它。如果涉及公式，计算模式也可以设置为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

如果与您的数据不匹配，请更改您需要的第三行中的工作表名称并调整第5行中的边界列（当前列WC）。

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

Answer 2

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

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

Answer 3

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

    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。

Excel将所有列与VBA合并

更新

更新2：

3 个答案: