Excel单元格合并

合并前： 合并后：

合并宏：

Sub 合并单元格()
    Dim colNum, rowNum, i, m As Integer
    Dim val As String
    val = MsgBox("是否要合并项目，资金账号，类别和品种列重复并连续的单元格？", vbYesNo)
    If val = vbNo Then
        Exit Sub
    End If
    colNum = 4
    rowNum = Cells(65535, colNum).End(xlUp).Row
    If Range("A2").MergeCells = True Or Range("B2").MergeCells = True Then
        Exit Sub
    End If
    
    i = 1
    While i <= rowNum
    
      If Cells(i, 4) = "账号合计" Then
          Range(Cells(i, 3), Cells(i, 3)).ClearContents         
          Range(Cells(i, 3), Cells(i, 4)).Merge                         
          
          Range(Cells(i, 3), Cells(i, 4)).VerticalAlignment = xlCenter
          Range(Cells(i, 3), Cells(i, 4)).HorizontalAlignment = xlCenter
          Range(Cells(i, 3), Cells(i, 4)).Interior.Color = RGB(192, 192, 192)
      End If
      i = i + 1
    Wend
    
    i = 1
    colNum = 1
    While i < rowNum
        m = 1
        While Cells(i + m, colNum) = Cells(i, colNum)
            m = m + 1
        Wend
      
        If m = 1 Then
            i = i + 1
        Else
            Range(Cells(i + 1, colNum), Cells(i + m - 1, colNum)).ClearContents
            Range(Cells(i, colNum), Cells(i + m - 1, colNum)).Merge
            Range(Cells(i, colNum), Cells(i + m - 1, colNum)).VerticalAlignment = xlCenter
            Range(Cells(i, colNum), Cells(i + m - 1, colNum)).HorizontalAlignment = xlCenter
            i = i + m
        End If
    Wend
    
    i = 1
    colNum = 2
    While i < rowNum
        m = 1
        While Cells(i + m, colNum) = Cells(i, colNum)
            m = m + 1
        Wend
      
        If m = 1 Then
            i = i + 1
        Else
            Range(Cells(i + 1, colNum), Cells(i + m - 1, colNum)).ClearContents
            Range(Cells(i, colNum), Cells(i + m - 1, colNum)).Merge
            Range(Cells(i, colNum), Cells(i + m - 1, colNum)).VerticalAlignment = xlCenter
            Range(Cells(i, colNum), Cells(i + m - 1, colNum)).HorizontalAlignment = xlCenter
            i = i + m
        End If
    Wend
    
    i = 1
    While i <= rowNum
    
      If Cells(i, 4) = "项目合计" Then
          Range(Cells(i, 2), Cells(i, 3)).ClearContents           
          Range(Cells(i, 2), Cells(i, 4)).Merge                  
          
          Range(Cells(i, 2), Cells(i, 4)).VerticalAlignment = xlCenter
          Range(Cells(i, 2), Cells(i, 4)).HorizontalAlignment = xlCenter
          Range(Cells(i, 2), Cells(i, 4)).Interior.Color = RGB(192, 192, 192)
      End If
      i = i + 1
    Wend
    
End Sub