【VBA】同じデータのセルを結合（Union未使用版）

下記のサイトで、同じデータのセルを結合するということで、Unionを使ってRangeをまとめて最後にMergeという処理を行っていました。

kouten0430.hatenablog.com

これはこれで良いのですが、非連続データならともかく、連続データである場合には、
個人的には、「何度もUnionせずに、範囲（開始行と終了行）を取得してMerge」とする方が好みなので、作ってみました。

Do Until の2重ループにして、以下のようなソースに。
（縦方向のマージ処理のみです）

外側のループで、基準となる行を進めていって、
内側のループで、基準となる値が終わる行を取得しています。

Public Sub doMerge()

    Dim r   As Range

    Set r = Sheet1.Range("A1").CurrentRegion
    Set r = r.Resize(r.Rows.Count - 1).Offset(1)

    Call MergeSameValueCellsV(r)

    Debug.Print "Done."

End Sub


Private Sub MergeSameValueCellsV(ByRef rTarget As Range)

    Const TARGGET_COL   As String = "A"

    Dim ws              As Worksheet
    Dim lCurrentRow     As Long
    Dim lNextRow        As Long
    Dim lEndRow         As Long
    Dim lMergeBeginRow  As Long
    Dim lMergeEndRow    As Long
    Dim vBaseValue      As Variant

    If rTarget Is Nothing Then
        Exit Sub
    ElseIf rTarget.Rows.Count = 1 Then
        Exit Sub
    End If

    Application.DisplayAlerts = False

    lCurrentRow = rTarget.Row
    lEndRow = rTarget.Row + rTarget.Rows.Count - 1

    Set ws = rTarget.Parent

    Do Until lCurrentRow > lEndRow

        lMergeBeginRow = lCurrentRow
        lMergeEndRow = lMergeBeginRow

        vBaseValue = ws.Range(TARGGET_COL & CStr(lCurrentRow)).Value

        lNextRow = lMergeBeginRow + 1

        Do Until vBaseValue <> ws.Range("A" & CStr(lNextRow)).Value
            lMergeEndRow = lNextRow

            lNextRow = lNextRow + 1
        Loop

        If lMergeEndRow > lMergeBeginRow Then
            'マージ開始行と終了行が違っていたら、マージ処理
            ws.Range(TARGGET_COL & CStr(lMergeBeginRow) & ":" & TARGGET_COL & CStr(lMergeEndRow)).Merge

            '次の処理は、マージした次の行から
            lCurrentRow = lCurrentRow + lMergeEndRow - lMergeBeginRow + 1
        Else
            'マージしないので次の行
            lCurrentRow = lCurrentRow + 1
        End If
    Loop

    Application.DisplayAlerts = True

End Sub