实用VBA：3.向下合并空白单元格

1.需求范例

从非格式化的表格、网页、word或其他格式文件中复制到Excel文件中的表格，对上下合并的单元格有时会将单元格内的文本内容保存在最上格中，下面其他单元格为空，需要将很多分散而无规律的非空单元格与其下的空白单元格合并。

例如下表

2.基本思路

表格特点是需要合并的单元格数据都在首行，只需要循环判断每个单元格下方的内容是否为空，如果为空就纳入与上方单元格合并的范围；如果不为空，说明到达了新的内容格，合并的下边界为前一行。

3.VBA实现

Option Explicit

Sub 向下合并空白单元格()
    Dim wb As Workbook                      '工作簿变量
    Dim ws As Worksheet                     '工作表变量
    Set wb = Workbooks(1)                   '设置当前工作簿
    Set ws = Worksheets("Sheet1")       '设置需要操作的工作表
    ws.Activate                                       '激活工作表
    Dim iCol As Integer                     '需处理的单元格列范围变量
    Dim iRow As Integer                   '处理数据的行游标变量
    Dim iStart As Integer                   '待合并的单元格范围起始行号
    Dim iEnd As Integer                    '待合并的单元格范围结束行号
    
    For iCol = 2 To 6                       '需处理的单元格位于B列至F列
        iStart = 2                               '变量初始化
        iEnd = 2                                '变量初始化
        
        For iRow = 3 To 17                  '从第3行开始进行判断，尾行数据在17行
        'iEnd始终比iRow小1，根据iRow所指向行单元格是否为空进行判断，若为空则上一组需合并单元格还未到底；
        '若不为空，则为下一组数据，上一组单元格应从iStart至iEnd行进行合并。
            If Cells(iRow, iCol) <> "" Then
                ws.Range(Cells(iStart, iCol), Cells(iEnd, iCol)).Merge
                iStart = iRow
                iEnd = iRow
            Else
                iEnd = iRow
            End If
        Next iRow
        
        ws.Range(Cells(iStart, iCol), Cells(iEnd, iCol)).Merge  '最后一组单元格合并
    Next iCol
    
    Set ws = Nothing                    '关闭工作表
    Set wb = Nothing                    '关闭工作簿
    
End Sub

4.运行效果