VBA 列方向合并单元格，左侧范围大于右侧范围

实现功能如下：
excel指定行列范围内的所有单元格
规则1：每一列的连续相同的值合并单元格
规则2：每一列的第一个非空单元格与其下方的所有空白单元格合并单元
规则3：优先左侧列合并单元格，合并后，右侧的单元格的合并范围的行上下限不能超过左侧的单元格范围。

如下图：

Sub MergeCellsBetweenNonEmpty()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 修改为你的工作表名称

    Dim startRow As Long, endRow As Long
    Dim startCol As Long, endCol As Long
    startRow = 1 ' 起始行号
    endRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' 动态获取结束行号
    startCol = 1 ' 起始列号
    endCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column ' 动态获取结束列号

    Dim i As Long, j As Long
    Dim firstNonEmptyRow As Long, secondNonEmptyRow As Long
    Dim hasNonEmptyCell As Boolean
    Dim mergeArea As Range

    ' 禁用屏幕更新和自动计算以提高性能
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False ' 禁用警告提示

    ' 循环遍历每一列
    For j = startCol To endCol
        firstNonEmptyRow = 0
        secondNonEmptyRow = 0
        hasNonEmptyCell = False

        ' 循环遍历每一行，查找所有符合条件的第一对非空单元格
        For i = startRow To endRow
            If ws.Cells(i, j).Value <> "" Then
                If firstNonEmptyRow = 0 Then
                    firstNonEmptyRow = i ' 找到第一个非空单元格
                ElseIf secondNonEmptyRow = 0 Then
                    secondNonEmptyRow = i ' 找到第二个非空单元格

                    ' 如果两个非空单元格之间有其他单元格，则尝试合并
                    If secondNonEmptyRow - firstNonEmptyRow > 1 Then
                        ' 计算右侧列的合并范围
                        Dim rightMergeStart As Long, rightMergeEnd As Long
                        rightMergeStart = firstNonEmptyRow
                        rightMergeEnd = secondNonEmptyRow - 1

                        ' 检查左侧列的合并范围
                        Dim leftMergeStart As Long, leftMergeEnd As Long
                        If j > startCol Then
                            On Error Resume Next
                            Set mergeArea = ws.Cells(rightMergeStart, j - 1).MergeArea
                            On Error GoTo 0

                            If Not mergeArea Is Nothing Then
                                leftMergeStart = mergeArea.Row
                                leftMergeEnd = leftMergeStart + mergeArea.Rows.Count - 1
                            Else
                                leftMergeStart = ws.Cells(rightMergeStart, j - 1).Row
                                leftMergeEnd = leftMergeStart
                            End If

                            ' 计算重叠区域
                            Dim overlapStart As Long, overlapEnd As Long
                            overlapStart = WorksheetFunction.Max(rightMergeStart, leftMergeStart)
                            overlapEnd = WorksheetFunction.Min(rightMergeEnd, leftMergeEnd)

                            ' 如果存在重叠区域且行数大于1，则合并
                            If overlapStart <= overlapEnd And (overlapEnd - overlapStart + 1) > 1 Then
                                With ws.Range(ws.Cells(overlapStart, j), ws.Cells(overlapEnd, j))
                                    .Merge
                                    .HorizontalAlignment = xlCenter
                                    .VerticalAlignment = xlCenter
                                End With
                            End If
                        Else
                            ' 第一列直接合并（检查行数是否大于1）
                            If (rightMergeEnd - rightMergeStart + 1) > 1 Then
                                With ws.Range(ws.Cells(rightMergeStart, j), ws.Cells(rightMergeEnd, j))
                                    .Merge
                                    .HorizontalAlignment = xlCenter
                                    .VerticalAlignment = xlCenter
                                End With
                            End If
                        End If
                    End If

                    ' 重置 firstNonEmptyRow 和 secondNonEmptyRow，继续查找下一对
                    firstNonEmptyRow = secondNonEmptyRow
                    secondNonEmptyRow = 0
                End If
                hasNonEmptyCell = True
            End If
        Next i

        ' 如果找到第一个非空单元格但未找到第二个非空单元格，则尝试合并到最后一行的单元格
        If firstNonEmptyRow > 0 And secondNonEmptyRow = 0 Then
            If endRow - firstNonEmptyRow > 0 Then
                ' 计算右侧列的合并范围
                rightMergeStart = firstNonEmptyRow
                rightMergeEnd = endRow

                ' 检查左侧列的合并范围
                If j > startCol Then
                    On Error Resume Next
                    Set mergeArea = ws.Cells(rightMergeStart, j - 1).MergeArea
                    On Error GoTo 0

                    If Not mergeArea Is Nothing Then
                        leftMergeStart = mergeArea.Row
                        leftMergeEnd = leftMergeStart + mergeArea.Rows.Count - 1
                    Else
                        leftMergeStart = ws.Cells(rightMergeStart, j - 1).Row
                        leftMergeEnd = leftMergeStart
                    End If

                    ' 计算重叠区域
                    overlapStart = WorksheetFunction.Max(rightMergeStart, leftMergeStart)
                    overlapEnd = WorksheetFunction.Min(rightMergeEnd, leftMergeEnd)

                    ' 如果存在重叠区域且行数大于1，则合并
                    If overlapStart <= overlapEnd And (overlapEnd - overlapStart + 1) > 1 Then
                        With ws.Range(ws.Cells(overlapStart, j), ws.Cells(overlapEnd, j))
                            .Merge
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlCenter
                        End With
                    End If
                Else
                    ' 第一列直接合并（检查行数是否大于1）
                    If (rightMergeEnd - rightMergeStart + 1) > 1 Then
                        With ws.Range(ws.Cells(rightMergeStart, j), ws.Cells(rightMergeEnd, j))
                            .Merge
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlCenter
                        End With
                    End If
                End If
            End If
        End If

        ' 如果该列没有非空单元格或全部是非空单元格，则不合并
        If Not hasNonEmptyCell Or (firstNonEmptyRow = startRow And secondNonEmptyRow = 0) Then
            GoTo NextColumn
        End If

NextColumn:
    Next j

    ' 新增规则：合并相邻相同内容的单元格
    For j = startCol To endCol
        For i = startRow To endRow
            If ws.Cells(i, j).Value <> "" Then
                Dim mergeStart As Long
                mergeStart = i

                ' 检查当前单元格与下一行单元格内容是否相同
                Do While i < endRow And ws.Cells(i + 1, j).Value = ws.Cells(mergeStart, j).Value
                    i = i + 1
                Loop

                ' 如果合并范围的行数大于1，则合并
                If i > mergeStart Then
                    With ws.Range(ws.Cells(mergeStart, j), ws.Cells(i, j))
                        .Merge
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                    End With
                End If
            End If
        Next i
    Next j

    ' 恢复屏幕更新和自动计算
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True ' 恢复警告提示

    MsgBox "合并完成！"
End Sub