AW: Zeilennummer beim Löschen behalten
03.09.2016 05:06:08
fcs
Hallo Tom,
das Makro funktioniert.
bei über 100000 Zeilen frisst dann irgendwann die Masse Zeit.
Die extrem lange Laufzeit kann zustande kommen, wenn in der Tabelle Formeln vorhanden sind insbesondere solche die Daten aus Zellbereichen mit vielen Zeilen verarbeiten, deren Inhalte gelöscht werden.
Dann versucht Excel dauernd das Tabellenblatt neu zu berechnen.
Auch das Entfernen der Zellfarbe bei jeder einzelnen schwarzen Zelle frisst Zeit.
Ich hab deshalb das Makro noch etwas optimiert und die Berechnung während der Makro-Ausführung auf "mauell" gesetzt.
Das Entfernen der schwarzen Füllfarbe erfolgt dann für die komplette Spalte am Schluss.
Wenn nur in den nicht-schwarzen Zeilen gelöscht werden sol, dann muss in der If-Prüfung das "=" durch "<>" ersetzt werden.
Frage: Wie färbst du denn die Zellen in Spalte A schwarz? Mit Füllfarbe in schwarz ändern oder per bedingter Formatierung?
Wenn bedingte Formatierung, dann funktioniert das Makro nicht.
Eine andere schnelle manuelle Methode (sollte auch unter Excel 2007 schon funktionieren) wäre manuell via Autofilter. Diese funktioniert auch bei Farben via bedingter Formatierung.
1. Markiere alle Zellen mit Daten im Tabellenblatt
2. Aktiviere via Menü "Daten" den Autofilter (Symbol "Filtern" (Trichter) anklicken).
In der 1. Zeile werden jetzt Drop-Down-Auswahl-Pfeile angezeigt.
3. Klicke in Spalte A auf den Pfeil und wähle "nach Farbe filtern" und dann die Farbe für die Zeilen, deren Inhalte du löschen möchtest.
4. markiere die Zellen, deren Inhalte gelöscht werden sollen und dann lösche
Es werden dann nur die Inhalte der sichtbaren Zellen gelöscht.
5. Deaktiviere via Menü "Daten" den Autofilter wieder durch erneutes anklicken)
Gruß
Franz
Public Sub Karin_loeschen_schwarze()
Dim lng_Row As Long
Dim StatusCalc As Long
Dim wks As Worksheet
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set wks = ActiveSheet
With wks
For lng_Row = .Cells(.Rows.Count, 1).End(xlUp).Row To 1 Step -1
If .Cells(lng_Row, 1).Interior.ColorIndex = 1 Then
'Inhalt in ganzer Zeile löschen
'.Rows(lng_Row).ClearContents
'Inhalt in bestimmten Spalten löschen. Hier: B bis I (2 bis 10)
.Range(.Cells(lng_Row, 2), .Cells(lng_Row, 10)).ClearContents
End If
Next
.Columns(1).Interior.ColorIndex = xlColorIndexNone
End With
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub
Public Sub Karin_loeschen_nicht_schwarze()
Dim lng_Row As Long
Dim StatusCalc As Long
Dim wks As Worksheet
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set wks = ActiveSheet
With wks
For lng_Row = .Cells(.Rows.Count, 1).End(xlUp).Row To 1 Step -1
If .Cells(lng_Row, 1).Interior.ColorIndex 1 Then
'Inhalt in ganzer Zeile löschen
'.Rows(lng_Row).ClearContents
'Inhalt in bestimmten Spalten löschen. Hier: B bis I (2 bis 10)
.Range(.Cells(lng_Row, 2), .Cells(lng_Row, 10)).ClearContents
End If
Next
.Columns(1).Interior.ColorIndex = xlColorIndexNone
End With
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub