Herbers Excel-Forum - das Archiv

Über mehrere Tabellen Zeilen löschen

Bild

Betrifft: Über mehrere Tabellen Zeilen löschen
von: Julia

Geschrieben am: 25.12.2006 14:58:00
hi,
vielleicht kann mir jemand einen Tip geben, wie man bei folgendem Skript die For...next-Schleife umgehen kann (oder so umschreiben kann, dass es schneller läuft), da es sehr lange dauert bis die ganzen Blätter abgearbeitet sind!?
Das Skript löscht über mehrere Blätter, die Zeilen bei denen in einem bestimmten Bereich keine Einträge stehen:
Sub LeereZeilenLöschen()
HDB = "gesamt"
For i = Sheets(HDB).index + 1 To Sheets.Count
a = Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
For zz = a To 7 Step -1
strName = ""
For Each e In Sheets(i).Range("F" & zz & ":IV" & zz)
strName = strName & e.Value
Next e
If strName = "" Then Sheets(i).Range("A" & zz).EntireRow.Delete
Next zz
Next i
End Sub

Wäre super, wenn mir jemand helfen könnte.
Gruß Julia
Bild

Betrifft: AW: Über mehrere Tabellen Zeilen löschen
von: Erich G.

Geschrieben am: 25.12.2006 19:16:18
Hallo Julia,
teste mal diesen Code:
Option Explicit
Sub LeereZeilenLöschen()
Dim ii As Integer, zz As Long, rngF As Range
Const HDB = "gesamt"
For ii = Sheets(HDB).Index + 1 To Sheets.Count
With Sheets(ii)
For zz = .Cells(Rows.Count, 1).End(xlUp).Row To 7 Step -1
Set rngF = Range(.Cells(7, 6), .Cells(zz, 256)).Find(What:="*", _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If rngF Is Nothing Then
Range(.Rows(7), .Rows(zz)).Delete
Exit Sub
ElseIf rngF.Row < zz Then
Range(.Rows(rngF.Row + 1), .Rows(zz)).Delete
zz = rngF.Row
End If
Next zz
End With
Next ii
End Sub
Rückmeldung wäre nett! - Erich aus Kamp-Lintfort wünscht dir schöne Feiertage!
Bild

Betrifft: AW: Über mehrere Tabellen Zeilen löschen
von: Erich G.

Geschrieben am: 25.12.2006 19:30:55
Hallo Julia,
falls deine Tabellen sehr groß sind und/oder viele Formeln enthalten, geht es damit schneller:
Option Explicit
Sub LeereZeilenLöschen()
Dim ii As Integer, zz As Long, rngF As Range
Const HDB = "gesamt"
Dim Calc As XlCalculation
Calc = Application.Calculation
Beschleuniger xlCalculationManual
For ii = Sheets(HDB).Index + 1 To Sheets.Count
With Sheets(ii)
For zz = .Cells(Rows.Count, 1).End(xlUp).Row To 7 Step -1
Set rngF = Range(.Cells(7, 6), .Cells(zz, 256)).Find(What:="*", _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If rngF Is Nothing Then
Range(.Rows(7), .Rows(zz)).Delete
Exit Sub
ElseIf rngF.Row < zz Then
Range(.Rows(rngF.Row + 1), .Rows(zz)).Delete
zz = rngF.Row
End If
Next zz
End With
Next ii
Beschleuniger Calc
End Sub
'   Beschleuniger _______ Parameter: Calc-Status ______ gi/12.03.2006
'Aufruf:
'   Dim Calc As XlCalculation
'   Calc = Application.Calculation: Beschleuniger xlCalculationManual
'   ....Code....
'   Beschleuniger Calc
Sub Beschleuniger(StatCal As XlCalculation)
Application.Calculation = StatCal
If StatCal = xlCalculationManual Then
Application.ScreenUpdating = False
Else
Application.ScreenUpdating = True
End If
End Sub
Rückmeldung wäre nett! - Erich aus Kamp-Lintfort wünscht nochmal schöne Feiertage!
Bild

Betrifft: AW: Zeilen löschen - Korrektur
von: Erich G.

Geschrieben am: 25.12.2006 19:38:48
Hallo Julia,
sorry, in der Routine hatte ich das "Exit ..." stehen lassen.
Es soll aber natürlich in jedem Fall der Beschleuniger wieder ausgeschaltet werden. Also noch mal:
Sub LeereZeilenLöschen()
Dim ii As Integer, zz As Long, rngF As Range
Const HDB = "gesamt"
Dim Calc As XlCalculation
Calc = Application.Calculation
Beschleuniger xlCalculationManual
For ii = Sheets(HDB).Index + 1 To Sheets.Count
With Sheets(ii)
For zz = .Cells(Rows.Count, 1).End(xlUp).Row To 7 Step -1
Set rngF = Range(.Cells(7, 6), .Cells(zz, 256)).Find(What:="*", _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If rngF Is Nothing Then
Range(.Rows(7), .Rows(zz)).Delete
GoTo XEnd
ElseIf rngF.Row < zz Then
Range(.Rows(rngF.Row + 1), .Rows(zz)).Delete
zz = rngF.Row
End If
Next zz
End With
Next ii
XEnd:
Beschleuniger Calc
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Bild

Betrifft: AW: Zeilen löschen - Korrektur
von: Julia

Geschrieben am: 25.12.2006 22:27:08
Hi Erich,
vielen Dank für deine Hilfe!
Geht um einiges schneller...eine echte Zeitersparnis :)
Vielleicht kannst du mir bei folgenden Problem noch zur Seite stehen?
Möchte bei diesen Blättern (wo Zeilen gelöscht wurden) noch die Spalten löschen, die als Summe den Wert 0 haben. Es sollen von "G4" bis "IV4" die Werte geprüft werden.
Eigentlich sollte als erstes das Skript mit "Spalten löschen", danach das mit "Zeilen löschen" laufen.
Gruß aus München
Julia
Bild

Betrifft: AW: Zeilen löschen - Korrektur
von: Erich G.

Geschrieben am: 25.12.2006 22:39:41
Hi Julia,
danke für deine Rückmeldung, freut mich!
Jetzt noch zwei Rückfragen:
- Gibt es Spalten von G bis IV, in denen nur Text steht? Die würden auch gelöscht.
- Sollen 0-Spalten komplett gelöscht werden (ab Zeile 1) oder erst ab Zeile 4?
Weihnachtliche Grüße von Erich aus Kamp-Lintfort
Bild

Betrifft: AW: Zeilen löschen - Korrektur
von: Julia
Geschrieben am: 25.12.2006 23:15:47
Hi Erich,
in den Spalten G:IV-Zeile 4 sind nur Summenformeln und wenn eine von den Zellen den SummenWert 0 hat soll die komplette Spalte gelöscht werden.
Hoffe das war verständlich was ich möchte?
Gruß Julia
Bild

Betrifft: AW: Zeilen löschen - Korrektur
von: Erich G.

Geschrieben am: 25.12.2006 23:57:52
Hallo Julia,
noch nicht wirklich getestet, sollte aber funzen (hoffentlich):
Sub NullSpalten_LeerZeilen_Löschen()
Dim ii As Integer, zz As Long, rngF As Range
Dim ssV As Integer, ssB As Integer, ssAnz As Integer
Const HDB = "gesamt"
Dim Calc As XlCalculation
Calc = Application.Calculation
Beschleuniger xlCalculationManual
For ii = Sheets(HDB).Index + 1 To Sheets.Count
With Sheets(ii)
' ------------------------------------------------- Spalten löschen
ssB = 256
Do While ssB > 7
Do While ssB > 7 And Cells(4, ssB) <> 0
ssB = ssB - 1
Loop
ssV = ssB + 1
Do While ssV > 7 And Cells(4, ssV - 1) = 0
ssV = ssV - 1
Loop
If ssV <= ssB Then
Range(Columns(ssV), Columns(ssB)).Delete
ssAnz = ssAnz + ssB - ssV + 1
ssB = ssV - 1
End If
Loop
' ------------------------------------------------- Zeilen löschen
For zz = .Cells(Rows.Count, 1).End(xlUp).Row To 7 Step -1
Set rngF = Range(.Cells(7, 6), .Cells(zz, 256 - ssAnz)).Find(What:="*", _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If rngF Is Nothing Then
Range(.Rows(7), .Rows(zz)).Delete
GoTo XEnd
ElseIf rngF.Row < zz Then
Range(.Rows(rngF.Row + 1), .Rows(zz)).Delete
zz = rngF.Row
End If
Next zz
End With
Next ii
XEnd:
Beschleuniger Calc
End Sub
Rückmeldung wäre nett! - Erich aus Kamp-Lintfort wünscht dir schöne Rest-Feiertage!
Bild

Betrifft: Spalten u. Zeilen löschen - Druckbereich?
von: Julia

Geschrieben am: 26.12.2006 20:35:20
Hi Erich,
sorry das ich mich erst jetzt melde.
Echt klasse!!! Vielen Dank nochmal für deine Hilfe.
waren zwar noch kleine Fehler drin, aber jetzt klappts:
Die Punkte haben gefehlt z.b. bei: .Cells, .Range, .Columns
hab bei die 0en in "0", sonst löscht es mir alle Spalten (in Zeile 4,die mit Summenwert 0 und die keinen Inhalt in der Zelle haben). Jetzt löscht es nur die mit Summenwert 0 raus.
Sub NullSpalten_LeerZeilen_Löschen()
Dim ii As Integer, zz As Long, rngF As Range
Dim ssV As Integer, ssB As Integer, ssAnz As Integer
Const HDB = "gesamt"
Dim Calc As XlCalculation
Calc = Application.Calculation
Beschleuniger xlCalculationManual
For ii = Sheets(HDB).Index + 1 To Sheets.Count
With Sheets(ii)
' ------------------------------------------------- Spalten löschen
ssB = 256
Do While ssB > 7
Do While ssB > 7 And .Cells(4, ssB) <> "0"
ssB = ssB - 1
Loop
ssV = ssB + 1
Do While ssV > 7 And .Cells(4, ssV - 1) = "0"
ssV = ssV - 1
Loop
If ssV <= ssB Then
.Range(.Columns(ssV), .Columns(ssB)).Delete
ssAnz = ssAnz + ssB - ssV + 1
ssB = ssV - 1
End If
Loop
' ------------------------------------------------- Zeilen löschen
For zz = .Cells(Rows.Count, 1).End(xlUp).Row To 7 Step -1
Set rngF = Range(.Cells(7, 6), .Cells(zz, 256)).Find(What:="*", _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If rngF Is Nothing Then
Range(.Rows(7), .Rows(zz)).Delete
GoTo XEnd
ElseIf rngF.Row < zz Then
Range(.Rows(rngF.Row + 1), .Rows(zz)).Delete
zz = rngF.Row
End If
Next zz
End With
XEnd:
Beschleuniger Calc
Next ii
End Sub

Hast du vielleicht (möchte dich nicht nerven:)) eine Idee, wie man schnell den einen Druckbereich für den benutzten Bereich für diese Blätter festlegen kann? Hab hier schon ein Skript, aber vielleicht fällt dir noch etwas dazu ein?
For i = Sheets(HDB).Index + 1 To Sheets.Count
'letzte benutzte Zeile ermitteln
LetzteZeile = Sheets(i).UsedRange.Rows.Count + 5
'letzte benutzte Spalte ermitteln
intNr = Sheets(i).UsedRange.Columns.Count - 3 'hier steuert man, welche Spalten weggelassen werden
'Ermitteln des Spalten-Buchstabens
On Error Resume Next
Cells(1, intNr).Select
ac = ActiveCell.Address
ab = Right(ac, Len(ac) - 1)
ac = Left(ab, Len(ab) - 2)
'Druckbereich festlegen
Sheets(i).PageSetup.PrintArea = ("A1:" & ac & LetzteZeile)
Next i
Application.ScreenUpdating = True
End Sub
Gruß Julia
Bild

Betrifft: AW: Spalten+Zeilen löschen + Druckbereich
von: Erich G.

Geschrieben am: 27.12.2006 13:18:33
Hi Julia,
da war ich wohl etwas schlampig mit den Punkten - sorry! - aber du hast es ja gleich ausgebügelt :-)
Beim Festlegen des Druckbereichs würde ich nicht vom UsedRange ausgehen. Der ist mitunter viel größer als der gewünschte Bereich.
In dem Makro war noch ein fetter Fehler (meinerseits):
Durch das "Goto XEnd" passiert es, dass etliche Blätter überhaupt nicht bearbeitet werden...
Da steht jetzt "Exit For".
Gleich im Löschen-Makro würde ich es so machen:
Sub NullSpalten_LeerZeilen_Löschen()
Dim ii As Integer, zz As Long, rngF As Range
Dim ssV As Integer, ssB As Integer, ssAnz As Integer
Const HDB = "gesamt"
Dim Calc As XlCalculation
Calc = Application.Calculation
Beschleuniger xlCalculationManual
For ii = Sheets(HDB).Index + 1 To Sheets.Count
With Sheets(ii)
' ------------------------------------------------- Spalten löschen
ssB = 256
Do While ssB > 7
Do While ssB > 7 And .Cells(4, ssB) <> "0"
ssB = ssB - 1
Loop
ssV = ssB + 1
Do While ssV > 7 And .Cells(4, ssV - 1) = "0"
ssV = ssV - 1
Loop
If ssV <= ssB Then
Range(.Columns(ssV), .Columns(ssB)).Delete
ssAnz = ssAnz + ssB - ssV + 1
ssB = ssV - 1
End If
Loop
' ------------------------------------------------- Zeilen löschen
For zz = .Cells(Rows.Count, 1).End(xlUp).Row To 7 Step -1
Set rngF = Range(.Cells(7, 6), .Cells(zz, 256 - ssAnz)).Find(What:="*", _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If rngF Is Nothing Then
Range(.Rows(7), .Rows(zz)).Delete
Exit For
ElseIf rngF.Row < zz Then
Range(.Rows(rngF.Row + 1), .Rows(zz)).Delete
zz = rngF.Row
End If
Next zz
' ------------------------------------------------- Druckbereich festlegen
zz = .Cells(Rows.Count, 1).End(xlUp).Row            ' Spalte A ist maßgebend
ssB = .Cells(4, Columns.Count).End(xlToLeft).Column ' Zeile 4  ist maßgebend
Sheets(ii).PageSetup.PrintArea = Range(.Cells(1, 1), .Cells(zz, ssB)).Address
End With
Next ii
Beschleuniger Calc
End Sub
Rückmeldung wäre nett! - Erich aus Kamp-Lintfort wünscht euch einen guten Rutsch!
Bild

Betrifft: AW: Spalten+Zeilen löschen + Druckbereich
von: Julia

Geschrieben am: 27.12.2006 23:00:35
Hi Erich,
nett, dass du Dich nochmal gemeldet hast!
Wenn man das Skript beim ersten Mal ablaufen lässt, läuft es super schnell, doch wenn man es mehrmals hintereinander benutzt, ist es um einiges langsamer als zuvor?:(?
Was mich auch wundert, dass das Skript so langsam ist, wenn man bei
Sheets(ii).PageSetup.PrintArea = Range(.Cells(1, 1)
nachfolgend z. b. noch einige Befehle für die Druckeigenschaften hinzufügt:
Sheet(ii).PrintTitleRows = WZE
Sheet(ii).PrintTitleColumns = WSP
Sheet(ii).RightFooter = "&10" & "Seite " & pj & "&P/&N"
Sheet(ii).PrintGridlines = True
Sheet(ii).Orientation = xlPortrait
Sheet(ii).BlackAndWhite = True
Sheet(ii).Zoom = 90
Hast du eine Ahnung was da los ist? Muss man vielleicht irgendwas reseten?!?!?
Gruß Julia
Bild

Betrifft: AW: Spalten+Zeilen löschen + Druckbereich
von: Erich G.

Geschrieben am: 28.12.2006 00:00:26
Hi Julia,
einen Grund für längere Laufzeiten bei mehrmaliger Ausführung sehe ich nicht.
Was ich nun aber auch nicht sehe, ist ein Grund, das Makro überhaupt mehrmals laufen zu lassen.
Wozu soll das gut sein?
Zu deiner zweiten Frage:
Zum Abarbeiten der Druck-Einstellungen benötigt Excel viel Zeit. Da habe ich keinen Dreh zum Beschleunigen gefunden.
Eventuell helfen Bedingungen der folgenden Art etwas (Beispielcode, am Ende des Makros):
         ' ------------------------------------------------- Druckbereich festlegen
zz = .Cells(Rows.Count, 1).End(xlUp).Row            ' Spalte A ist maßgebend
ssB = .Cells(4, Columns.Count).End(xlToLeft).Column ' Zeile 4  ist maßgebend
.PageSetup.PrintArea = Range(.Cells(1, 1), .Cells(zz, ssB)).Address
With .PageSetup
If .Orientation <> xlPortrait Then .Orientation = xlPortrait
End With
End With
Next ii
Beschleuniger Calc
End Sub
Noch eine Bemerkung:
Sheet(ii).Orientation = xlPortrait
ist wohl kaum lauffähig. Sheets fehlte das s, und Orientation ist keine Worksheet-Eigenschaft,
sondern eine PageSetup-Eigenschaft. Ausführlich müsste es
Sheets(ii).PageSetup.Orientation = xlPortrait
heißen.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Bild

Betrifft: AW: Spalten+Zeilen löschen + Druckbereich
von: Julia

Geschrieben am: 28.12.2006 00:53:30
Hi Erich,
bei Sheet(ii).PrintTitleRows = WZE..., das war ein Schreib/Kopierfehler! Sorry.
(sonst würde ich doch gar nicht bemerken, dass es so ewig dauert:)
Das mit der wiederholten Markoausführung, hat was damit zu tun, dass wenn ich bei den einzelnen Blättern Daten ändere z.B. das durch eine Änderung eventuell bei einigen Blättern Spalten einen neuen Summenwert mit 0 ergeben.
Dieses Skript nehme ich dann zur Aktualisierung dieser geänderten Blätter.
Hoffe das war einigermaßen verständlich...
Schade das Du keine Lösung für mein Problem hast. Da muss man einfach damit leben.
Ich danke Dir nochmals für Deine sehr hilfreiche Unterstützung!
Gruß Julia
Dir auch einen guten Rutsch ins neue Jahr 2007
 Bild
Excel-Beispiele zum Thema "Über mehrere Tabellen Zeilen löschen"
Suche über mehrere Tabellen Mehrere Schaltflächen für ein Makro
Suchbegriff über mehrere Tabellenblätter suchen. Benutzerdefinierte SVERWEIS-Funktion über mehrere Bereiche
Druck aus mehreren Tabellenblättern auf eine Druckseite AutoFilter über mehrere Arbeitsblätter setzen
Daten von mehreren Blättern auf ein Druckblatt Prozentuale Erhöhung über mehrere Arbeitsblätter hinweg
Werte in mehreren Spalten sortieren Textreihe auf mehrere Spalten mit fester Seitenlänge verteilen