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。
我使用的是 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。