Получить начать диапазон и конечный диапазон вертикально объединенные ячеек с Excel с помощью VBA

Question

Мне нужно выяснить первую ячейку и последнюю ячейку вертикально объединенной ячейки ..

Скажем, я Объединить ячейки В2 до В50 ,
Как я могу получить в VBA стартовую ячейку (= B2) и конечную ячейку (= B50)?

Answer 1

Ну, если вы знаете адрес одной из ячеек в объединенном диапазоне, вы можете просто выбрать смещение из этого диапазона и получить строку/столбец:

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 

Код выше будет бросать ошибки если строка смещения не может быть выбрана (т. е. если объединенные строки равны A1 через все), поэтому вы захотите добавить обработку ошибок, которая сообщает коду, если он не может компенсировать, верхние строки должны быть 1, и если он не может вниз, нижний ряд должен быть 65 536. Этот код также является только одним, поэтому вы можете также добавить ось x.

Answer 2

Если вы хотите, чтобы ячейка ссылалась на строки, вы можете использовать что-то вроде этого, где Location, StartCell и EndCell являются строковыми переменными.

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

Если вы хотите установить их как диапазоны, вы можете добавить это, где StartRange и EndRange являются объектами Range.

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

Answer 3

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 

Answer 4

Ниже макрос проходит через все листы в книге и находит объединенные ячейки, разъединить их и положить исходное значение для всех объединенных ячеек.

Это часто необходимо для приложений БД, поэтому я хотел поделиться с вами.

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