Sub ZeilenLoeschen()
Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Sub ZeilenEinfuegen()
Dim i As Long
Application.ScreenUpdating = False
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row * 2 Step 2
Rows(i).Insert Shift:=xlDown
Next
Application.ScreenUpdating = True
End Sub
Gruß Jürgen
AW: Schleifen brauchen ewig
hary
Hi Larissa
zum loeschen(wenn die Zellen wirklich leer sind) versuch mal
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Gruss hary
AW: Schleifen brauchen ewig
Tino
Hallo,
habe auch mal zwei Makros zusammengebastelt.
Beachte bei Makro 2 (einfügen Leere Zeilen) die Bedingung die erfüllt sein muss, sonst geht es nicht.
Dafür sollte es aber recht schnell sein.(hoffe ich ;-))
Option Explicit
'zum Loeschen
Sub LeereZeilenLoeschen()
Dim Bereich As Range, SortBereich As Range
Dim LCol As Long
Dim iCalc As Integer
With Application
iCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
'Bereich anpassen, hier Spalte 1
Set Bereich = Range("A1", Cells(Rows.Count, 1).End(xlUp))
LCol = Bereich.Column
Set Bereich = Bereich.Offset(0, Columns.Count - LCol)
Set SortBereich = Bereich.Offset(0, -1)
SortBereich.FormulaR1C1 = "=ROW()"
Bereich.FormulaR1C1 = "=IF(RC" & LCol & "="""",0,"""")"
If .WorksheetFunction.CountIf(Bereich, 0) > 0 Then
Range("A1", Cells(Rows.Count, Columns.Count)).Sort Bereich(1, 1), xlAscending, , , , , , xlNo
Bereich.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
Range("A1", Cells(Rows.Count, Columns.Count)).Sort SortBereich(1, 1), xlAscending, , , , , , xlNo
End If
Columns(Columns.Count).Delete
Columns(Columns.Count - 1).Delete
.Calculation = iCalc
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
'zum Einfügen,
'Benutzte Zellen in Spalte A dürfen nicht über die Hefte der Anzahl zur Verfügung stehenden Zeilen gehen.
'bis xl2003 max 32768
'ab xl2007 max 524288
Sub LeereZeilenEibfuegen()
Dim strString As String
Dim Bereich As Range, SortBereich As Range
Dim LCol As Long
Dim iCalc As Integer
With Application
iCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
'Bereich anpassen, hier Spalte 1
Set Bereich = Range("A1", Cells(Rows.Count, 1).End(xlUp))
Set Bereich = Bereich.Offset(0, Columns.Count - Bereich.Column)
Bereich.FormulaR1C1 = "=ROW()"
Bereich.Offset(Bereich.Rows.Count, 0).FormulaR1C1 = "=Row()-" & Bereich.Cells(Bereich.Cells.Count).Row & "+ 0.1"
Set Bereich = Union(Bereich, Bereich.Offset(Bereich.Rows.Count, 0))
Cells.Sort Bereich(1, 1), xlAscending, , , , , , xlNo
Columns(Columns.Count).Delete
.Calculation = iCalc
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Gruß Tino
AW: Schnelles Einfügen mit Sortieren
Daniel
Hallo
wenn du schnell Leerzeilen löschen und einfügen willst, empfiehlt sich die Sortierfunktion:
hier ein Makro zum schnellen Löschen, dabei spielt es keine Rolle, ob die Leerzellen in Spalte A echte Leerzellen sind oder durch Formeln erzeugt werden. Beides wird gelöscht:
Sub LeerLöschen()
With ActiveSheet.UsedRange
With .Columns(.Columns.Count).Offset(0, 1)
.FormulaR1C1 = "=if(RC1 = """","""",row())"
.Formula = .Value
.EntireRow.Sort Key1:=.Cells(1, 1), order1:=xlAscending, header:=xlNo
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
.EntireColumn.Clear
End With
End With
End Sub
und hier das Makro zum schnellen einfügen von Leerzeilen:
Sub Leerzeilen_Einfügen()
With ActiveSheet.UsedRange
With .Columns(.Columns.Count).Offset(0, 1)
.Formula = "=Row()"
.Formula = .Value
.Copy .Cells(1, 1).End(xlDown).Offset(1, 0)
.CurrentRegion.Sort Key1:=.Cells(1, 1), order1:=xlAscending, header:=xlNo
.EntireColumn.Clear
End With
End With
End Sub
Gruß, Daniel
AW: Schnelles Einfügen mit Sortieren
Larissa
Danke Ihr Lieben, dieses Forum ist einfach klasse und kompetent.
So viele Lösungsvorschläge :-)
Ich werde sie alle ausprobieren.
Sorry für die späte Antwort, ich hatte leider keinen Zugang zum Internet.
|