Moin auch,
in einer kleinen Exceldatei mit nur knapp 1.000.000 Zeilen will ich alle die löschen, die in der 3. Spalte ein X tragen.
Code:
Sub delete\_x()
Dim reihe As Long
Application.Screenupdating = False
For reihe = 987654 To 1 Step -1
If Cells(reihe, 3).Value = "X" Then
Cells(reihe, 3).EntireRow.Delete shift:=xlUp
End If
Next
Application.Screenupdating = True
End Sub
Das Makro funktioniert an sich, dauert aber eeeeewig. Wie kann ich denn den Code optimieren, damit das Löschen schneller geht?
Ralph
Grüezi Ralph
Sortiere deine Daten zuerst nach deiner dritten Spalte, ermittle dann mit .Find und durch Zählen wo der Bereich beginnt und wie gross er ist und lösche diesen dann als kompletten Block.
Wenn Du in dieser Spalte sonst keine leeren Zellen drin hast, dann ersetzt das ‚X‘ durch ‚nix‘ und lösche nach dem Sortieren mit SpecialCells(xlCellTypeBlank) alle Zeilen die ‚nix‘ enthalten auf einen Schlag.
Mit freundlichen Grüssen
Thomas Ramel
Moin auch,
Ich hätte erwähnen sollen, dass die Reihen aufeinander aufbauen. Der Eintrag in Zelle (10,1) MUSS nach dem Eintrag in Zelle (9,1) stehen. Deswegen funktioniert der an sich nützliche Trick mit dem Sortieren leider nicht.
Ralph
Grüezi Ralph
Ich hätte erwähnen sollen, dass die Reihen aufeinander
aufbauen. Der Eintrag in Zelle (10,1) MUSS nach dem Eintrag in
Zelle (9,1) stehen. Deswegen funktioniert der an sich
nützliche Trick mit dem Sortieren leider nicht.
Mit einer Hilfsspalte kann man ja nach dem Löschen wieder zurück sortieren lassen… 
Mit freundlichen Grüssen
Thomas Ramel
Moin auch,
Mit einer Hilfsspalte kann man ja nach dem Löschen wieder
zurück sortieren lassen…
Eben. Das fiel mir auch eben ein, aber du bist einfach schneller.
Ralph
Das Makro funktioniert an sich, dauert aber eeeeewig. Wie kann
ich denn den Code optimieren, damit das Löschen schneller
geht?
Hallo Ralph,
Sub delete\_x()
Dim reihe As Long
On Error Resume Next
Application.ScreenUpdating = False
With Range("AA1:AA987654")
.Formula = "=IF(C1=""X"","""",1)"
.Value = .Value
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
.ClearContents
End With
Application.ScreenUpdating = True
End Sub
Gruß
Reinhard
Lösung
Moin auch,
als Aufklärung: Ging nicht! Die Fehlermeldung war von der Art „Excel kann die Aktion mit den vorhandenen Resourcen nicht ausführen“. 600.000 Zeilen waren wohl einfach zuviel. Aber 400.000 Zeilen kopieren, das ging:
Sub delete\_X()
Dim strBereich As String
Dim wksTab1 As Worksheet
Set wksTab1 = Sheets("DAT-File2")
strBereich = Range(Cells(136500, 1), Cells(253498, 2)).Address
wksTab1.Range(strBereich).Copy
Sheets("Results").Cells(462985, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, \_
SkipBlanks:=False, Transpose:=False
Set wksTab1 = Nothing
End Sub
Ja, ich habe feste Bezüge, was von Übel ist, das geht (mir) aber schneller von der Hand.
Ralph