Get rozpocząć zakres i końcowy zakres pionowo połączyła komórce Excel przy użyciu VBA

Question

muszę dowiedzieć się pierwszą komórkę i ostatnią komórkę pionowo połączyła komórce ..

Powiedzmy scalić komórki B2 do B50 .
Jak mogę uzyskać w VBA komórkę początkową (= B2) i komórkę końcową (= B50)?

Answer 1

Cóż, zakładając, że znasz adres jednej z komórek połączonego zakresie, można po prostu wybrać przesunięcie w tym zakresie i uzyskać wiersz/kolumna:

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 

Powyższy kod rzuci błędy jeśli nie można wybrać wiersza z przesunięciem (tj. jeśli połączone wiersze to A1 przez cokolwiek), więc będziesz chciał dodać obsługę błędów, która powie kodowi, jeśli nie może się przesunąć, górne wiersze muszą wynosić 1, a jeśli nie może w dół, dolny rząd musi być 65 536. Ten kod jest również tylko jeden wymiar, więc możesz również dodać oś X.

Answer 2

Jeśli chcesz, aby odwołania do komórek były łańcuchami, możesz użyć czegoś takiego, gdzie Lokalizacja, StartCell i EndCell są zmiennymi łańcuchowymi.

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

Jeśli chcesz ustawić je jako zakresy, dodaj to, gdzie StartRange i EndRange są obiektami 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

Poniżej makro przechodzi przez wszystkie arkusze w skoroszycie i stwierdza scalone komórki, rozdzielić je i umieścić oryginalną wartość wszystkich połączonych komórek.

Jest to często potrzebne w przypadku aplikacji DB, więc chciałem się z Tobą podzielić.

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