循环遍历列中的合并单元格以在 VBA 中获取它们的地址

Question

我有一个专栏。比如说 A 列，它有多个不同范围的合并单元格。

例如，第一个单元格从 A2 合并到 A15，而第二个合并单元格的范围从 A16 到 A115。

我想遍历整个列以获取每个合并单元格的地址。

以下代码仅适用于第一个单元格，但我想遍历 A 列中的所有单元格。

Sub Macro()

    Dim rng As Range, rngStart As Range, rngEnd As Range

    Set rng = Range("A2")

    If rng.MergeCells Then

        Set rng = rng.MergeArea
        Set rngStart = rng.Cells(1, 1)
        Set rngEnd = rng.Cells(rng.Rows.Count, rng.Columns.Count)

        MsgBox "First Cell " & rngStart.Address & vbNewLine & "Last Cell " & rngEnd.Address

    Else

        MsgBox "Not merged area"

    End If
End Sub

Answer 1

它仅适用于单个单元格的原因是因为您将rng 设置为单个单元格。因此，我使用for each cell in rng 循环遍历 A 列直到最后一行。

Sub macro()

    Dim rng As Range, rngStart As Range, rngEnd As Range, cell As Range
    Dim ws As Worksheet
    Dim lRow As Long
    Dim arr() As String

    Set ws = ActiveSheet
    With ws
        lRow = .Cells(.Rows.Count, 1).End(xlUp).row 'Get the last row in the activesheet
        Set rng = .Range("A1:A" & lRow)
    End With

    For Each cell In rng
        If cell.MergeArea.Cells(1, 1).Address = cell.Address Then

            If cell.MergeArea.Cells.Count > 1 Then

                arr() = Split(cell.MergeArea.Address, ":")
                Set rngStart = Range(arr(0))
                Set rngEnd = Range(arr(1))
                MsgBox "First Cell " & rngStart.Address & vbNewLine & "Last Cell " & rngEnd.Address

            Else

                MsgBox "Not merged area"
            End If
        End If
    Next
End Sub

Answer 2

子宏()

调暗为范围 调暗开始为范围 将 rngEnd 调暗为范围

Set rng = Range("A2")

If rng.MergeCells Then

    Set rng = rng.MergeArea
    Set rngStart = rng.Cells(1, 1)
    Set rngEnd = rng.Cells(rng.Rows.Count, rng.Columns.Count)

    MsgBox "First Cell " & rngStart.Address & vbNewLine & "Last Cell " & rngEnd.Address

Else

    MsgBox "Not merged area"

End If

结束子

这是适用于单个单元格的代码