Excel, alle Versionen

Eine Aufgabe, die ganz einfach scheint: Nach jeder Zeile soll in Excel eine leere Zeile eingefügt werden. Nichts einfacher als das …

Das geht bei drei, vier einzufügenden Zeilen ja noch ganz einfach per Hand, aber zehn Zeilen sind nun wirklich die Grenze des Zumutbaren. Und wenn es dann noch mehr einzufügende Zeilen sind, dann artet das in Arbeit aus.  😎 Da bietet sich förmlich der Einsatz eines Makros an. Dieses nimmt Ihnen die Arbeit komplett ab. Binden Sie das folgende Makro in die ent­spre­chende Tabelle (oder ein getrenntes Modul) ein. Wie das geht, erfahren Sie hier.

In der ersten Version dieser Aufgabe wurde im gesamten Datenbereich eine Leerzeile eingefügt. Hier in diesem Teil geht es darum, nur in einem ausgewählten, einem selektierten, zusammenhängenden  Bereich oberhalb jeder der markierten Zeilen eine Leerzeile ein­zufügen. Dabei ist es unerheblich, in welcher Spalte die Markierung, die Selektion vor­ge­nom­men worden ist. Es reicht eine Spalte, es dürfen aber auch die gesamten Zeilen sein.

Hinweis: Die Darstellung auf Ihrem Bildschirm weicht in manchen Fällen vom Code in der Datei ab, das ist ohne Relevanz und nur der Optik wegen.

▲ nach oben …

Option Explicit

Sub ZeilenEinfuegenBereich()
' Hinweis: Die 1. Zeile wird stets OBERHALB
' der Markierung eingefügt
   Dim lngAnzRows As Long, lngMaxRow As Long
   Dim lngAnzRowsSel As Long, lngAnzRowsWks As Long
   Dim lngLastDataRow As Long, lngFirstDataRow As Long, lngFreeRows As Long
   Dim i As Long
   Dim bolPartOnly As Boolean
   
   'Maximale/alle Zeilen des WorkSheets ermitteln
   lngAnzRowsWks = Rows.Count
   'Letzte Datenzeile ermitteln
   lngLastDataRow = ActiveSheet.Cells(lngAnzRowsWks, 1).End(xlUp).Row
   
   'Hier wird die erste Leerzeile eingefügt, falls nicht
   'mehrere Zeilen markiert sind. Bei Bedarf ändern
   lngFirstDataRow = 2
   'Noch freie Zeilen feststellen
   lngFreeRows = lngAnzRowsWks - lngLastDataRow
   lngMaxRow = lngFreeRows / 2 'Die Hälfte davon
   lngAnzRowsSel = lngLastDataRow
   
   'Prüfen, ob mehrere Zeilen zusammenhängend markiert sind
   If Selection.Rows.Count > 1 Then
      If MsgBox(lngAnzRowsSel & " Zeilen sind " _
       & "zusammenhängend markiert, " & vbCrLf _
       & "sollen nur in diesem "  _
       &"Bereich Leerzeilen eingefügt werden?", _
       vbYesNo, "Bereich festlegen") = vbYes Then
         bolPartOnly = True
         lngAnzRowsSel = Selection.Rows.Count
         lngFirstDataRow = Selection.Row
         lngAnzRows = Selection.Rows.Count
         lngLastDataRow = lngFirstDataRow + lngAnzRows - 1
         End If
   End If 
   
   On Error GoTo Fehler
   'Wegen Schnelligkeit und Flimmern
   Application.ScreenUpdating = False
   If lngMaxRow >= lngAnzRowsSel Then
      For i = lngLastDataRow To lngFirstDataRow Step -1
         Rows(i).EntireRow.Insert
      Next i
      ' Falls nach der letzten markierten Zeile
      ' KEINE Leerzeile eingefügt werden soll,
      ' die folgende Zeile auskommentieren oder löschen
      If bolPartOnly Then Rows(lngLastDataRow + _
       lngAnzRowsSel + 1).EntireRow.Insert
      Else 'Es wären zu viele Zeilen
         MsgBox "Zu viele Datenzeilen," & vbCrLf _
          & "ein Einfügen von Leerzeilen ist nicht möglich.", _
          vbCritical + vbOKOnly, "Fehler!"
   End If
Fehler:
   Application.ScreenUpdating = True
End Sub

▲ nach oben …

Dieses Makro prüft auch ab, ob genügend Zeilen zur Verfügung stehen. Wenn die Daten­zeilen mehr als 50% der verfügbaren Zeilen einnehmen, dann wird eine entsprechende Fehlermeldung ausgegeben.

Hinweis: Bereits vorhandene Leerzeilen werden als ganz normale Datenzeilen behandelt, es wird also nicht geprüft, ob in der jeweils aktuellen Zeile Daten stehen oder nicht. – Zum testen steht Ihnen eine Excel-Datei (im 2007er-Format) hier zur Verfügung; den reinen VBA-Code können Sie hier als gepackte *.zip-Datei mit der *.bas (reiner Text) und einer *.cls (Text, zum direkten Import) herunterladen und dann in Ihre Datei einfügen.

▲ nach oben …

Hat Ihnen der Beitrag gefallen?
Erleichtert dieser Beitrag Ihre Arbeit?

Dann würde ich mich über einen Beitrag Ihrerseits z.B. 2,00 € freuen …