Registriert seit: 05.08.2014
Version(en): 2013
Liebe Excel VBA Experten,
mit meinem folgendem Programmcode lassen sich Leerzeilen über einen beliebigen Bereich sofort löschen:
Sub Leerzeilenweg()
vbBereich = "A1 :" & ActiveCell.SpecialCells(xlLastCell).Address
Range(vbBereich).SpecialCells(xlCellTypeBlanks).Delete
End Sub
Was ich nun bräuchte wäre der umgekehrte Fall. Sagen wir ich möchte in jeder zweiten Zeile wieder eine Leerzeile stehen haben. Wie füge ich diese Leerzeilen genauso schnell wieder ein?
Registriert seit: 10.04.2014
Version(en): 2016 + 365
09.08.2014, 15:04
(Dieser Beitrag wurde zuletzt bearbeitet: 09.08.2014, 15:24 von Rabe.)
Hallo Christa,
(09.08.2014, 14:40)ChristaRohn schrieb: Was ich nun bräuchte wäre der umgekehrte Fall. Sagen wir ich möchte in jeder zweiten Zeile wieder eine Leerzeile stehen haben. Wie füge ich diese Leerzeilen genauso schnell wieder ein?
also manuell würde ich es folgendermaßen machen:
- Ich schreibe in eine Hilfsspalte eine fortlaufende Nr bei jeder belegten Zeile (in die erste eine 1, dann markieren, Doppelklick auf das kleine Kästchen rechts unten in der Zelle).
- Dann kopiere ich diesen Spalteninhalt in dieselbe Spalte unter die belegten Zeilen.
- Dann sortiere ich den gesamten Bereich nach der Hilfsspalte und schon habe ich unterhalb jeder belegten Zeile eine Leerzeile.
Diesen Vorgang nun per Rekorder aufgenommen und Du hast ein Makro, das dann noch verallgemeinert und optimiert werden könnte.
So sieht das aufgenommene erst mal aus:
Code: Option Explicit
Sub Leerzeilen_einfügen()
'
' Leerzeilen_einfügen Makro
'
'
Range("C2").FormulaR1C1 = "1"
Selection.AutoFill Destination:=Range("C2:C22"), Type:=xlFillSeries
Range("C2:C22").Select
Selection.Copy
Range("C23").Select
ActiveSheet.Paste
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range("C1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tabelle1").Sort
.SetRange Range("A2:C43")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Folgende(r) 1 Nutzer sagt Danke an Rabe für diesen Beitrag:1 Nutzer sagt Danke an Rabe für diesen Beitrag 28
• ChristaRohn
Registriert seit: 14.04.2014
Version(en): 2003, 2007
Hallo Christa,
hier eine Variante:
Code: Sub jedeZweiteLeer()
Dim i As Long
Dim lngLetzte As Long
Dim strgZelle As String
lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row
strgZelle = Range("A2").Address
For i = 3 To lngLetzte
strgZelle = strgZelle & "," & Range("A" & i).Address
Next i
Range(strgZelle).EntireRow.Insert
End Sub
Gruß Atilla
Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:1 Nutzer sagt Danke an atilla für diesen Beitrag 28
• ChristaRohn
Registriert seit: 14.04.2014
Version(en): 2003, 2007
09.08.2014, 20:15
(Dieser Beitrag wurde zuletzt bearbeitet: 09.08.2014, 20:55 von Rabe.)
Hallo noch einmal,
das war jetzt etwas vorschnell.
Die Methode funktioniert zwar, aber hat ihre Grenze sehr schnell erreicht.
Man kann nämlich max. 255 Zeichen als String zusammenfassen und einem Range übergeben.
Das wäre hier bei 67 Zelladressen der Fall, auch nur dann , wenn man die Zelladressen nicht
Absolut (ohne Dollarzeichen) übergibt. Das war beim bisherigen Code nicht der Fall.
Unten jetzt eine korrigierte Fassung:
Code: Option Explicit
Sub jedeZweiteLeer()
Dim i As Long, j
Dim lngLetzte As Long
Dim strgZelle As String
lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row
If lngLetzte > 67 Then
MsgBox "Mit dieser Methode können nur maximal 67 Zeilen eingefügt werden" _
& vbLf & vbLf & "Die Ausführung wird unterbrochen!"
Exit Sub
End If
strgZelle = Range("A2").Address(0, 0)
For i = 3 To lngLetzte
strgZelle = strgZelle & "," & Range("A" & i).Address(0, 0)
Next i
Range(strgZelle).EntireRow.Insert
End Sub
Falls Du mehr Zeilen einfügen möchtest, dann melde Dich noch einmal.
Teile dann mit, ob es Zellen mit Formeln gibt, welche beim Einfügen und Löschen einer Hilfsspalte
in Mitleidenschaft gezogen werden würden.
Gruß Atilla
Registriert seit: 05.08.2014
Version(en): 2013
Hallo liebe Leute,
für das Leerzeilen einfügen benutzte ich bisher immer folgenden Code:
Dim i As Integer
Dim z As Integer
Application.ScreenUpdating = False
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
For z = 1 To 1
Cells(i, 1).EntireRow.Insert Shift:=xlDown
Next z
Next i
Application.ScreenUpdating = True
das funktioniert natürlich gut. Aber ich dachte einfach an etwas genialeres! Vielleicht irgendetwas mit
einer Matrix oder so etwas?!
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallo Christa,
hast Du das mit der Hilfsspalte von Rabe mal ausprobiert? Wenn Du Excel-Tabellenfunktionalitäten benutzt, gehen manche Sachen einfach und schneller. Ich habe das über 10.000 Zeilen laufen lassen - dauert unter 0,2 Sekunden. Das Wegnehmen der leeren "Zeilen" mit Deinem code dauert dann ca. 66,5 Sekunden.
Hier mal meine angepasste Variante. Ich habe die Zeilenzahl flexibel gestaltet und fange in Zeile 1 / Zelle B1 an. Statt B musst Du eine leere Spalte unmittelbar neben Deinem Tabellenbereich nehmen (wegen dem xlToLeft). Die Zeitausgabe kann dann wieder weg.
Code: Option Explicit
'Deklaration der API-Funktion
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Sub Leerzeilenweg()
Dim vbBereich$
Dim loStartTime As Long
loStartTime = GetTickCount
vbBereich = "A1:A" & Cells(Rows.Count, 1).End(xlUp).Row
'vbBereich = "A1:" & ActiveCell.SpecialCells(xlLastCell).Address
Range(vbBereich).SpecialCells(xlCellTypeBlanks).Delete
MsgBox "Laufzeit " & _
(GetTickCount - loStartTime) / 1000 & " Sekunden.", _
vbInformation, "Application.Wait Soll: 3 Sekunden"
End Sub
Sub Leerzeilen_einfügen()
'
' Leerzeilen_einfügen Makro
Dim loStartTime As Long, loLastRow As Long
'Startzeit uebernehmen
loStartTime = GetTickCount
loLastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("B1").FormulaR1C1 = "1"
Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=1, Stop:=10000, Trend:=False
Range("B1:B" & loLastRow).Copy Range("B" & loLastRow + 1)
Range("B1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range("B1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tabelle1").Sort
.SetRange Range("A2:B" & loLastRow * 2)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
MsgBox "Laufzeit " & _
(GetTickCount - loStartTime) / 1000 & " Sekunden.", _
vbInformation, "Application.Wait Soll: 3 Sekunden"
End Sub
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:1 Nutzer sagt Danke an schauan für diesen Beitrag 28
• ChristaRohn
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
10.08.2014, 08:42
(Dieser Beitrag wurde zuletzt bearbeitet: 10.08.2014, 08:43 von schauan.)
Hallo Christa,
hier hab ich mal auf Basis von Ralf's code das Löschen von Leerzeilen. Bei dem Beisiel mit den 10.000 Zeilen, was mit Deinem code über eine Minute läuft, bin ich hier auch im Bereich unter 0,2 Sekunden.
Hier nutze ich wieder die Funktion GetTickCount für die Laufzeitausgabe.
Code: Sub Leerzeilenweg2()
Dim vbBereich$
Dim loStartTime As Long, loLastRow As Long
loStartTime = GetTickCount
loLastRow = Cells(Rows.Count, 1).End(xlUp).Row
vbBereich = "A1:A" & loLastRow
'vbBereich = "A1:" & ActiveCell.SpecialCells(xlLastCell).Address
'Range(vbBereich).SpecialCells(xlCellTypeBlanks).Delete
Range(vbBereich).Offset(, 2).FormulaR1C1 = "=N(RC[-2]="""")*100000+ROW()"
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range("C1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tabelle1").Sort
.SetRange Range("A2:C" & loLastRow)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1 & ":C" & loLastRow).Clear
MsgBox "Laufzeit " & _
(GetTickCount - loStartTime) / 1000 & " Sekunden.", _
vbInformation, "Application.Wait Soll: 3 Sekunden"
End Sub
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 05.08.2014
Version(en): 2013
Hallo André,
danke für den Super Profi Code. Bräuchte jetzt noch so etwas um die Leerzellen wieder einzufügen.
Registriert seit: 10.04.2014
Version(en): 2016 + 365
Hi Christa,
(10.08.2014, 09:39)ChristaRohn schrieb: Hallo André,
danke für den Super Profi Code. Bräuchte jetzt noch so etwas um die Leerzellen wieder einzufügen.
dann schau mal in Andrés Beitrag von 09:20 Uhr.
Registriert seit: 05.08.2014
Version(en): 2013
Lieber Ralf,
richtig. Ihr seid beim Lösen schneller als ich beim Lesen. Sorry!
|