ottenere un inizio intervallo e Fine intervallo di una cella verticale fusa con Excel utilizzando VBA

Question

ho bisogno di scoprire la prima cella e l'ultima cella di una cella unita verticalmente ..

Diciamo che unire le celle B2 fino a B50 .
Come posso inserire in VBA la cella iniziale (= B2) e la cella finale (= B50)?

Answer 1

Beh, supponendo che si conosce l'indirizzo di una delle celle nell'intervallo unito, si può solo selezionare l'offset da tale intervallo e ottenere la riga/colonna:

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 

Il codice qui sopra gettare errori se la riga sfalsata non può essere selezionata (cioè se le righe unite sono A1 attraverso qualsiasi cosa) quindi vorrete aggiungere la gestione degli errori che dice al codice se non può essere compensato, le prime file devono essere 1 e se non può andare giù, la riga inferiore deve essere 65.536. Questo codice è anche solo unidimensionale, quindi potresti voler aggiungere anche l'asse x.

Answer 2

Se si desidera che i riferimenti di cella come stringhe, è possibile utilizzare qualcosa come questo, dove Posizione, StartCell ed EndCell sono variabili stringa.

Se si desidera impostarli come intervalli, è possibile aggiungere questo, dove StartRange e EndRange sono oggetti 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

Sotto macro passa attraverso tutti i fogli in una cartella di lavoro e trova celle unite, li unmerge e mettere il valore originale per tutte le celle unite.

Questo è spesso necessario per le applicazioni DB, quindi ho voluto condividere con voi.

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