作用描述:Excel本身所带的跨越合并功能可以对区域数据按行进行合并,但没有提供按列进行合并的功能,借助于此宏脚本实现该功能


1、按下Alt+F8,给宏起名,点击创建

wKiom1M5UArCg2pSAACFa-9pE0U603.jpg


2、新创建的宏主体部分是空白的,在sub和end sub之间粘贴以下脚本

'Sub merge()
' 纵向合并单元格
On Error GoTo ErrorHandler
Dim co, ro, hi, wi As Integer
'co起始列,ro起始行,hi需要合并的行数,wi需要处理的列数
co = Selection.Column
ro = Selection.Row
hi = Selection.Rows.Count
wi = Selection.Columns.Count
Selection.UnMerge
ActiveSheet.Range(Cells(ro, co), Cells(ro, co)).Resize(hi, 1).Select
'选中第一个需要合并的单元格区域
While wi > 0
    If WorksheetFunction.CountA(Selection) = 0 Then
    Selection.merge
'判断非空单元格数量,存在非空单元格时,不执行合并操作
    End If
ActiveCell.Offset(0, 1).Resize(hi, 1).Select
'选中下一个需要合并的单元格区域
wi = wi - 1
Wend
ActiveSheet.Cells(ro, co).Select
ErrorHandler:
End Sub

3、粘贴完成后是这样的,关闭编辑窗口

wKioL1M5T-OgvAc7AAHC5hLaOVc864.jpg


4、给宏设置快捷键,按Alt+F8,选项,设置快捷键

wKiom1M5UAuDc0ilAAE-8X5bgfo417.jpg


5、选中需要合并的单元格区域

wKioL1M5T-PQTGVYAAA9VPUf7iM374.jpg


6、按下设置的快捷键(比如上面图中设置的Ctrl+q)得到合并后的单元格效果

wKiom1M5UAugV2WQAAArlHowpKQ040.jpg


备注:1、如果Excel未启用宏,脚本不能执行

     2、为防止操作错误导致数据丢失,脚本不对含有数据的单元格执行合并操作

        如果需要合并第一行有数据的区域,使用以下

        If WorksheetFunction.CountA(Selection.Offset(1, 0).Resize(hi - 1, 1)) = 0 Then

        替换 If WorksheetFunction.CountA(Selection) = 0 Then

     3、对已经合并的单元格同样有效

wKiom1M5UAvyX7FpAADP1PcNQl8363.jpg