Startseite

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