Get start range and end range of a vertically merged cell with Excel using VBA

I need to find out the first cell and the last cell of a vertically m开发者_StackOverflow中文版erged cell..

Let's say I merge Cells B2 down to B50.

How can I get in VBA the start cell(=B2) and the end cell(=B50)?

Sub MergedAreaStartAndEnd()

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

    Set rng = Range("B2")

    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

Below macro goes through all sheets in a workbook and finds merged cells, unmerge them and put original value to all merged cells.

This is frequently needed for DB applications, so I wanted to share with you.

Sub BirlesenHucreleriAyirDegerleriGeriYaz()
    Dim Hucre As Range
    Dim Aralik
    Dim icerik
    Dim mySheet As Worksheet

    For Each mySheet In Worksheets

    mySheet.Activate
    MsgBox mySheet.Name & “ yapılacak…”

    For Each Hucre In mySheet.UsedRange
        If Hucre.MergeCells Then
           Hucre.Orientation = xlHorizontal
           Aralik = Hucre.MergeArea.Address
           icerik = Hucre
           Hucre.MergeCells = False
           Range(Aralik) = icerik
        End If
    Next

 MsgBox mySheet.Name & " Bitti!!"

 Next mySheet
End Sub

Suppose you merged B2 down to B50.

Then, start cell address will be:

MsgBox Range("B2").MergeArea.Cells(1, 1).Address

End cell address will be:

With Range("B2").MergeArea
    MsgBox .Cells(.Rows.Count, .Columns.Count).Address
End With

You can put address of any cell of merged area in place of B2 in above code.

Well, assuming you know the address of one of the cells in the merged range, you could just select the offset from that range and get the row/column:

Sub GetMergedRows()
    Range("A7").Select 'this assumes you know at least one cell in a merged range.
    ActiveCell.Offset(-1, 0).Select
    iStartRow = ActiveCell.Row + 1
    Range("A7").Select
    ActiveCell.Offset(1, 0).Select
    iEndRow = ActiveCell.Row - 1
    MsgBox iStartRow & ":" & iEndRow
End Sub

The code above will throw errors if the offset row cannot be selected (i.e. if the merged rows are A1 through whatever) so you will want to add error handling that tells the code if it can't offset up, the top rows must be 1 and if it can't go down, the bottom row must be 65,536. This code is also just one dimensional so you might want to add the x-axis as well.

If you want the cell references as strings, you can use something like this, where Location, StartCell, and EndCell are string variables.

Location = Selection.Address(False, False)
Colon = InStr(Location, ":")
If Colon <> 0 Then
    StartCell = Left(Location, Colon - 1)
    EndCell = Mid(Location, Colon + 1)
End If

If you want to set them as ranges, you could add this, where StartRange and EndRange are Range objects.

set StartRange = Range(StartCell)
set EndRange = Range (EndCell)

If you intend to loop through the merged cells, try this.

Sub LoopThroughMergedArea()
    Dim rng As Range, c As Range

    Set rng = [F5]

    For Each c In rng.MergeArea
        'Your code goes here
        Debug.Print c.Address'<-Sample code
    Next c
End Sub