Zellenverbinden (Excel)

Aus Thomas Wiki
Version vom 13. März 2017, 15:46 Uhr von Thomas (Diskussion | Beiträge)
(Unterschied) ← Nächstältere Version | Aktuelle Version (Unterschied) | Nächstjüngere Version → (Unterschied)
Zur Navigation springen Zur Suche springen

Makros zum Verbinden von Zellen in einer Spalte, die den gleichen Wert haben.

NameVormame
AdlerInge
Jens
Karin
DinkelHugo
MeierLars
Uwe
MeyerSonja
Thorsten
Uwe
Function LastUsedRow_1(MySheet As Worksheet) As Long

'UsedRange property to find the last used row number in a worksheet

Dim lastRow As Long


lastRow = MySheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count

LastUsedRow_1 = lastRow


End Function

Function LastUsedRow_2(MySheet As Worksheet) As Long


'UsedRange property to find the last used row number in a worksheet

Dim lastRow As Long


lastRow = MySheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row

LastUsedRow_2 = lastRow


End Function


Function Str_NB(Z As Long)

  S = Str(Z)
  Str_NB = Right(S, Len(S) - 1)

End Function

Sub Zellenvereinigen(Spalte As String, Anfang As Long, Ende As Long)
 
  Application.DisplayAlerts = False
  With Range(Spalte + Str_NB(Anfang), Spalte + Str_NB(Ende))
        .Merge
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
  End With
  Application.DisplayAlerts = True
  
End Sub

Sub Verbinden_nach_Wert()

'
' Zellen farblich abwechselnd nach Werten markieren
' Makro am 03.01.2012 von Thomas Arend aufgezeichnet
'
  Dim WertSpalte, ZielSpalte As String
  Dim StartZeile As Long
  Dim EndZeile As Long
  
  WertSpalte = "A"
  ZielSpalte = "B"

  StartWert = Range(WertSpalte + "2").Value
  StartZeile = 2
  EndZeile = 2
    
  For Each C In Range(WertSpalte + "3", WertSpalte + Str_NB(LastUsedRow_1(ActiveSheet)))
       
    If C.Value = StartWert Then
     ' C.Value = Null
      EndZeile = EndZeile + 1
    Else
      Call Zellenvereinigen(ZielSpalte, StartZeile, EndZeile)
      StartWert = C.Value
      EndZeile = EndZeile + 1
      StartZeile = EndZeile
    End If
     
  Next

  If EndZeile > StartZeile Then
    Call Zellenvereinigen(ZielSpalte, StartZeile, EndZeile)
  End If

End Sub