Zellen verbinden und Texte einfügen
Dieses Makro verbindet Zellen und fügt vorgegebene Texte ein. Im vorgestellten Beispiel werden die
Spaltenüberschriften eingetragen. Die entsprechenden Zellen werden verbunden und farblich formatiert. Der Monatswechsel wird erkannt.
Option Explicit
Sub zellen_verbinden()
' verbindet Zellen in einer Reihe
Dim sp As Integer ' Variable deklarieren
Dim az As Integer ' "
Dim spp As Integer ' "
Dim s As Integer ' "
Dim mon ' "
mon = Array("Januar", "Februar", "März", "April", "Mai", _
"Juni", "Juli", "August", "September", "Oktober", _
"November", "Dezember") ' Inhalte an Variable übergeben
For sp = 1 To Range("IV2").End(xlToLeft).Column ' Start der Schleife
Cells(8, 1) = sp
If sp > 1 Then ' wenn sp größer als 1 dann ...
If Month(Cells(2, sp)) <> Month(Cells(2, sp - 1)) _
Then ' ... wenn Zahl ungleich letzte Zahl dann ...
spp = sp ' ... spp gleich sp
' Anzahl der Zellen ermitteln
Do While Month(Cells(2, spp)) = _
Month(Cells(2, sp)) ' ... laufe von Startwert bis Ende der Tabelle
spp = spp + 1 ' ... Schleifenzähler um Wert 1 erhöhen
Loop ' ... Wendepunkt für Schleife
' Zellen verbinden
Range(Cells(1, sp), Cells(1, spp - 1)).Select ' ... Bereich selektieren
Selection.Merge ' ... Zellen verbinden
Selection.HorizontalAlignment = xlCenter ' ... Schrift zentrieren
' Zellen färben
s = s + 1 ' Zähler um wert 1 erhöhen
Selection.Font.Bold = True ' Fette Schrift einstellen
If s = 1 Then ' wenn Zähler 1 dann ...
Selection.Font.ColorIndex = 2 ' ... Textfarbe weiß
With Selection.Interior ' ... Hintergrund selektieren
.ColorIndex = 10 ' ... Farbe dunkelgrün
End With ' Ende färben
End If ' Ende Bedingung
If s = 2 Then s = 0 ' Wenn Zähler = 2 dann Zähler = 0
' Text ausgeben
az = Month(Cells(2, sp)) ' Monat ermitteln
Cells(1, sp) = mon(az - 1) ' ... Text ausgeben
End If ' Ende Bedingung
End If ' Ende Bedingung
Next sp ' Wendepunkt für For Next Schleife
End Sub