Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
568to572
568to572
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zeilen löschen

Forumthread: Zeilen löschen

Zeilen löschen
18.02.2005 11:46:38
Benny
Hallo,
ich habe ein Makro welches mir die letzte aktive Zeile ermittelt. Dann werden alle vorhergehenden Zeilen geprüft ob in der Spalte A ein Eintrag vorhanden ist. Dort wo es in Spalte A keinen Eintrag gibt wird diese Zeile gelöscht.

Sub loesche_Leerzeilen()
Dim ActRow, LastRow
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
ActRow = 1
While (ActRow < LastRow)
If (IsEmpty(Cells(ActRow, 1))) Then
Rows(ActRow).Delete
LastRow = LastRow - 1
Else
ActRow = ActRow + 1
End If
Wend
End Sub

Nun möchte ich das Makro abwandeln.
Es soll in einem Range("A4:E15") oder Rows("4:15") geprüft werden ob es dort Leerzellen oder Leerzeilen gibt und nur in diesem Range bzw. Row sollen diese dann gelöscht werden.
Wer kann mir dort helfen.
Vielen Dank
Benny
Anzeige

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeilen löschen
Uduuh
Hallo,
meinst du das so?
Wenn irgendeine Zelle in Spalte A:E der Zeile leer ist, wird die Zeile gelöscht.

Sub loesche_Leerzeilen()
Dim ActRow, LastRow
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
ActRow = 1
While (ActRow < LastRow)
If application.worksheetfunction.counta(Range(cells(actrow,1),cells(actrow,5)))<5 Then
Rows(ActRow).Delete
LastRow = LastRow - 1
Else
ActRow = ActRow + 1
End If
Wend
End Sub

Gruß aus'm Pott
Udo

Anzeige
AW: Zeilen löschen
18.02.2005 12:33:41
Benny
Hallo Udo,
nein so war es nicht gemeint. Trotzdem vielen Dank. Die andere Antwort vom Werner hat genau das Ergebnis geliefert welches ich brauchte.
Vielen dank für deine Mühe.
Gruß
Benny
AW: Zeilen löschen
WernerB.
Hallo Benny,
wie gefällt Dir das?

Sub Benny()
Dim i As Long
Application.ScreenUpdating = False
For i = 15 To 4 Step -1
If WorksheetFunction.CountA(Rows(i)) = 0 Then
Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True
End Sub

Viel Erfolg wünscht
WernerB.
P.S.: Dieses Forum lebt auch von den Rückmeldungen der Fragesteller an die Antworter !
Anzeige
AW: Zeilen löschen
18.02.2005 12:40:55
Benny
Hallo Werner,
vielen Dank du hast das Problem genau erkannt und deine Lösung ist sofort einsetzbar.
Bitte erkläre mir warum "For i = 15 To 4 Step -1" rückwärts gezählt wird und man nicht von Zeile 4 - 15 vorwärts zählt.
Des weiteren würde ich gerne wenn dieses Worksheet abgearbeitet ist, die gleiche Prozedur noch in einem weiteren Worksheet ablaufen lassen. Jedoch habe ich pro Worksheet zwei Zeilenbereiche die ich prüfen lassen möchte, nämlich Zeile 4-15 und 44-55. Nachdem die Leerzeilen dann entfernt wurden sollen diese übrig gebliebenen Zeilen in ein neues Worksheet kopiert werden.
Hast du da vielleicht auch eine prakmatische Lösung für mich.
Danke für die Mühe
Gruß
Benny
Anzeige
AW: Zeilen löschen
WernerB.
Hallo Benny,
wenn man die Zeilen von oben nach unten abarbeitet, wird bei aufeinander folgenden Leerzeilen wegen der von unten nachrückenden Zeilen die eine oder andere übersprungen; dies kann bei der Abarbeitung in umgekehrter Richtung nicht passieren.
Hier das gewünschte Beispiel-Makro:

Sub Benny()
Dim i As Long, _
z1 As Byte, z2 As Byte
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
z1 = 15
For i = 15 To 4 Step -1
If WorksheetFunction.CountA(.Rows(i)) = 0 Then
z1 = z1 - 1
.Rows(i).Delete
End If
Next i
End With
With Worksheets("Tabelle2")
z2 = 55
For i = 55 To 44 Step -1
If WorksheetFunction.CountA(.Rows(i)) = 0 Then
z2 = z2 - 1
.Rows(i).Delete
End If
Next i
End With
Sheets.Add After:=Sheets(Sheets.Count)
Worksheets("Tabelle1").Range("A4:IV" & z1).Copy _
Destination:=Worksheets(Sheets.Count).Range("A1")
Application.CutCopyMode = False
Worksheets("Tabelle2").Range("A44:IV" & z2).Copy _
Destination:=Worksheets(Sheets.Count).Range("A" & z1 - 2)
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Gruß
WernerB.
Anzeige
AW: Zeilen löschen
18.02.2005 14:01:21
Benny
Hallo Werner,
echt super wie viel Mühe du dir machst. Ich meinte mit den beiden Zeilenbereichen das sie jeweils immer in einem Worksheet vorkommen und das pro Workshett. Diesbezgl. habe ich das Makro geändert, ist das so OK.

Sub Benny()
Dim i As Long, _
z1 As Byte, z2 As Byte
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
z1 = 15
For i = 15 To 4 Step -1
If WorksheetFunction.CountA(.Rows(i)) = 0 Then
z1 = z1 - 1
.Rows(i).Delete
End If
Next i
z2 = 55
For i = 55 To 44 Step -1
If WorksheetFunction.CountA(.Rows(i)) = 0 Then
z2 = z2 - 1
.Rows(i).Delete
End If
Next i
End With
With Worksheets("Tabelle2")
z1 = 15
For i = 15 To 4 Step -1
If WorksheetFunction.CountA(.Rows(i)) = 0 Then
z1 = z1 - 1
.Rows(i).Delete
End If
Next i
z2 = 55
For i = 55 To 44 Step -1
If WorksheetFunction.CountA(.Rows(i)) = 0 Then
z2 = z2 - 1
.Rows(i).Delete
End If
Next i
End With
Sheets.Add After:=Sheets(Sheets.Count)
Worksheets("Tabelle1").Range("A4:IV" & z1).Copy _
Destination:=Worksheets(Sheets.Count).Range("A1")
Application.CutCopyMode = False
Worksheets("Tabelle2").Range("A44:IV" & z2).Copy _
Destination:=Worksheets(Sheets.Count).Range("A" & z1 - 2)
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Ich habe auch noch die ein oder andere Frage.
Was bedeutet Range("A44:IV" & z2), fehlt bei IV nicht etwas?
Wo werden die nicht leeren Zeilen der Tabelle1 und Tabelle2, z.B. hintereinander in Tabelle 3 kopiert?
Hoffe das ich mich nicht zu dumm anstelle.
Gruß
Martin
Anzeige
AW: Zeilen löschen
WernerB.
Hallo Benny!
1. "IV" ist die letzte Spalte im Tabellenblatt, die Variable "z2" beinhaltet die entsprechende Zeilennummer.
2. Die nicht leeren Zeilen der Tabellen1 und 2 werden in ein neu erstelltes Tabellenblatt hintereinander ab Zeile 1 kopiert.
3. Hier das Makro:

Sub Benny()
Dim i As Long, laR As Long, _
z1 As Byte, z2 As Byte, z3 As Byte, j As Byte
Application.ScreenUpdating = False
Sheets.Add After:=Sheets(Sheets.Count)
For j = 1 To 2
With Worksheets("Tabelle" & j)
z1 = 15
z3 = 44
For i = 15 To 4 Step -1
If WorksheetFunction.CountA(.Rows(i)) = 0 Then
z1 = z1 - 1
z3 = z3 - 1
.Rows(i).Delete
End If
Next i
z2 = z3 + 11
For i = z3 + 11 To z3 Step -1
If WorksheetFunction.CountA(.Rows(i)) = 0 Then
z2 = z2 - 1
.Rows(i).Delete
End If
Next i
End With
With Worksheets(Sheets.Count)
On Error Resume Next
laR = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
If laR = 1 And .Cells(1, 1).Value = "" Then laR = 0
On Error GoTo 0
Worksheets("Tabelle" & j).Range("A4:IV" & z1).Copy _
Destination:=.Range("A" & laR + 1)
Application.CutCopyMode = False
On Error Resume Next
laR = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
On Error GoTo 0
Worksheets("Tabelle" & j).Range("A" & z3 & ":IV" & z2).Copy _
Destination:=.Range("A" & laR + 1)
Application.CutCopyMode = False
End With
Next j
Application.ScreenUpdating = True
End Sub

Gruß und schönes WE
WernerB.
Anzeige
Korrektur
WernerB.
Hallo Martin/Benny,
bitte entferne diese Zeile aus dem Makro; sie ist unnötig und könnte u.U. einen Fehler verursachen:
If laR = 1 And .Cells(1, 1).Value = "" Then laR = 0
Danke!
Gruß
WernerB.
AW: Korrektur
21.02.2005 08:09:58
Benny
Hallo Werner,
hoffe du hattest noch ein schönes Wochenende,
Leider funktioniert das Makro nicht.
Ich bekomme einen Laufzeitfehler '9':
Index außerhalb des gültigen Bereiches
Wenn ich dann auf Debuggen klicke bleibt der Cursor bei - With Worksheet ("Tabelle1" & j) stehen. Liegt das vielleicht an der Benennung meiner Blätter?
Ich habe die Excel-Datei einmal mit angehangen.
https://www.herber.de/bbs/user/18409.xls
Es wäre prima wenn du sie noch einmal prüfen würdest. Danke für deine Mühe.
Liebe Grüße
Martin
Anzeige
AW: Korrektur
WernerB.
Hallo Benny,
das Makro habe ich jetzt auf Deine Tabellenblattbezeichnungen angepasst.
Allerdings verstehe ich die Sinnhaftigkeit, die Zeilen 4-15 sowie 44-55 in beiden Blättern auf Inhalte zu überprüfen, überhaupt nicht
.
Außerdem weise ich darauf hin, dass Zellen, die Formeln enthalten, nicht "leer" sind, auch wenn die Formeln die Ausgabe von Leerzeichen bewirken.
Zudem verwendest Du verbundene Zellen, die die Funktion eines Makros erheblich beeinträchtigen können.

Sub losche_Leerzeilen_kopiere_Rest()
Dim i As Long, laR As Long, _
z1 As Byte, z2 As Byte, z3 As Byte, j As Byte
Application.ScreenUpdating = False
Sheets.Add After:=Sheets(Sheets.Count)
For j = 1 To 2
With Worksheets("0" & j)
z1 = 15
z3 = 44
For i = 15 To 4 Step -1
If WorksheetFunction.CountA(.Rows(i)) = 0 Then
z1 = z1 - 1
z3 = z3 - 1
.Rows(i).Delete
End If
Next i
z2 = z3 + 11
For i = z3 + 11 To z3 Step -1
If WorksheetFunction.CountA(.Rows(i)) = 0 Then
z2 = z2 - 1
.Rows(i).Delete
End If
Next i
End With
With Worksheets(Sheets.Count)
On Error Resume Next
laR = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
On Error GoTo 0
Worksheets("0" & j).Range("A4:IV" & z1).Copy _
Destination:=.Range("A" & laR + 1)
Application.CutCopyMode = False
On Error Resume Next
laR = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
On Error GoTo 0
Worksheets("0" & j).Range("A" & z3 & ":IV" & z2).Copy _
Destination:=.Range("A" & laR + 1)
Application.CutCopyMode = False
End With
Next j
Application.ScreenUpdating = True
End Sub

Gruß
WernerB.
Anzeige
AW: Korrektur
21.02.2005 15:14:47
Benny
Hallo Werner,
nach einigen Tests und verändern diverser Werte, ist das Makro nun fast so wie gewünscht. Deine Frage nach der Sinnhaftigkeit erklärt sich dadurch, dass ich nicht wußte das ein abprüfen einer Zeile auf "Leer" auch auf Formeln greift.
Nun würde ich das Makro noch ein bißchen ausbauen wollen.
Die weiteren Schritte in dem neuen Tabellenblatt stelle ich mir wie folgt vor:
1.) umbenennen den neuen Tabellenblattes in SuS
2.) Spalte A markieren
3.) Bearbeiten - Gehe zu - Inhalte - Leerzellen anklicken
4.) Bearbeiten - Zellen löschen - Ganze Zeile
5.) Sortieren nach Spalte F - B - A (wenn möglich, ansonsten auflösen der Formatierung, dann sortieren und zum Schluss die Formatierung wieder übertragen)
Das würde ich über einen Makrorkorder aufzeichnen und in das u.a. Makro integrieren. Jedoch habe ich beim sortieren so meine Schwierigkeiten. Kannst du mir auch dort helfen.

Sub losche_Leerzeilen_kopiere_Rest()
Dim i As Long, laR As Long, _
z1 As Byte, z2 As Byte, z3 As Byte, j As Byte
Application.ScreenUpdating = False
Sheets.Add After:=Sheets(Sheets.Count)
For j = 1 To 2
With Worksheets("0" & j)
z1 = 41
z3 = 53
For i = 41 To 6 Step -1
If WorksheetFunction.CountA(.Rows(i)) = 0 Then
z1 = z1 - 1
z3 = z3 - 1
.Rows(i).Delete
End If
Next i
z2 = z3 + 36
For i = z3 + 12 To z3 Step -1
If WorksheetFunction.CountA(.Rows(i)) = 0 Then
z2 = z2 - 1
.Rows(i).Delete
End If
Next i
End With
With Worksheets(Sheets.Count)
On Error Resume Next
laR = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
On Error GoTo 0
Worksheets("0" & j).Range("A4:IV" & z1).Copy _
Destination:=.Range("A" & laR + 1)
Application.CutCopyMode = False
On Error Resume Next
laR = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
On Error GoTo 0
Worksheets("0" & j).Range("A" & z3 & ":IV" & z2).Copy _
Destination:=.Range("A" & laR + 1)
Application.CutCopyMode = False
End With
Next j
Application.ScreenUpdating = True
End Sub

Viele Grüße
Benny
Anzeige
AW: Korrektur
WernerB.
Hallo Benny,
ich hoffe, das klappt so wie gewünscht:

Sub losche_Leerzeilen_kopiere_Rest()
Dim Adr As String, _
i As Long, laR As Long, _
z1 As Byte, z2 As Byte, z3 As Byte, j As Byte
Application.ScreenUpdating = False
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).name = "SuS"
For j = 1 To 2
With Worksheets("0" & j)
z1 = 41
z3 = 53
For i = 41 To 6 Step -1
If WorksheetFunction.CountA(.Rows(i)) = 0 Then
z1 = z1 - 1
z3 = z3 - 1
.Rows(i).Delete
End If
Next i
z2 = z3 + 36
For i = z3 + 12 To z3 Step -1
If WorksheetFunction.CountA(.Rows(i)) = 0 Then
z2 = z2 - 1
.Rows(i).Delete
End If
Next i
End With
With Worksheets(Sheets.Count)
On Error Resume Next
laR = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
On Error GoTo 0
Worksheets("0" & j).Range("A4:IV" & z1).Copy _
Destination:=.Range("A" & laR + 1)
Application.CutCopyMode = False
On Error Resume Next
laR = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
On Error GoTo 0
Worksheets("0" & j).Range("A" & z3 & ":IV" & z2).Copy _
Destination:=.Range("A" & laR + 1)
Application.CutCopyMode = False
End With
Next j
With Worksheets(Sheets.Count)
On Error Resume Next
laR = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
On Error GoTo 0
If laR = 0 Then Exit Sub
.Range("A1:A" & laR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Adr = .Cells(.Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row, _
.Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column).Address
.Range("A1:" & Adr).Sort Key1:=.Range("F1"), Order1:=xlAscending, Key2:=.Range("B1"), _
Order2:=xlAscending, Key3:=.Range("A1"), Order3:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
End With
Application.ScreenUpdating = True
End Sub

Gruß
WernerB.
Anzeige
AW: Korrektur
22.02.2005 08:31:43
Benny
Hallo Werner,
leider bleibt das Makro an der u.a. Stelle mit folgender Fehlermeldung stehen.
Laufzeitfehler (1004)
Für diese Aktionen müssen alle verbundenen Zellen dieselbe Größe haben
.Range("A1:" & Adr).Sort Key1:=.Range("F1"), Order1:=xlAscending, Key2:=.Range("B1"), _
Order2:=xlAscending, Key3:=.Range("A1"), Order3:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
Was wäre wenn man erst die Formatierung löst dann sortiert und hinterher die Formatierung wieder setzt.
Oder es wird das Blatt SuS erst in SuS1 kopiert, dann dort die Formatierung gelöst, sortiert und die Formatierung von SuS übernommen. Danach wird das Blatt SuS gelöscht und SuS1 in SuS umbenannt.
Sorry aber kannst du mir auch dabei helfen.
Gruß
Benny
Anzeige
AW: Korrektur
WernerB.
Hallo Benny,
auf mögliche Makro-Probleme im Zusammenhang mit verbundenen Zellen habe ich Dich bereits hingewiesen.
Grundsätzlich weigere ich mich auch, hier irgendwelche diesbezügliche zeitraubende Experimente durchzuführen, zumal kein befriedigendes Ergebnis garantiert werden kann.
Gruß
WernerB.
Anzeige
AW: Korrektur
22.02.2005 10:13:49
Benny
Hallo Werner,
noch einmal vielen Dank für deine Ausdauer und bisherige Mühe. Ich freue mich sehr das du mir so weit helfen konntest, bis demnächst.
Noch eine erfolgreiche Woche.
Gruß
Benny
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige