Hallo SJ!
ein Kollege von mir hat mir folgende Code geschrieben, dass ist nicht dynamischer, jedoch aber ziemlich schnell!
Wie zu Beginn bereits erwähnt, möchte ich, nach der Kriteriumszelle I4, die Spalte I (ab zeile I7) auf das Kriterium prüfen.
Das heißt, wenn ich in die Kriteriumzelle I4 eingebe: <4, sollen alle Zeilen gelöscht werden, die in der Spalte I einen Wert beinhalt der nicht <4 ist.
Zum Einen spielt Geschwindigkeit eine Rolle, zum anderen soll der zu überprüfende Bereich auch dynamisch sein. Das heißt, die Datensatzanzahl ab Zeile 7 kan variieren. Da können 20 Zeilen folgend aber auch 20.000.
Das i-Tüpfelchen wäre, wenn man in die Kriteriumzelle einen Zahlenbereich derfinieren könnte. Zum Beispiel größer als 5 und kleiner als 10. Anahnd davon, soll dann die Überprüfung in der Spalte I folgen.
Leute, schon jetzt tausend Dank für eure Beiträge! Ihr seit der Hammer!
Gruß rotkiv1x1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Start&, Zeilen#, OldCalc#
On Error GoTo EvOn
If Target.Address = "$I$4" Then
If Target.Value = vbNullString Then Exit Sub
With Application
OldCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
.DisplayAlerts = False
End With
If MsgBox("Spalte I mit dem Kriterium " & Target.Value & " unwiderruflich löschen?", _
vbYesNo + vbCritical) = vbNo Then
MsgBox "Löschung abgebrochen!" & vbLf & "Kriterium wird gelöscht!"
Target = vbNullString
Else
Start = Timer
Range("J6") = "Dummy"
Range("J7") = 1
With Range("J7:J150006")
.DataSeries
.CurrentRegion.Sort Range("I7"), Header:=xlYes
End With
Range("I6:I150006").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("K1:K2"), Unique:=False
Zeilen = Range("7:150006").SpecialCells(xlCellTypeVisible).Rows.Count
Range("7:1048576").SpecialCells(xlCellTypeVisible).Delete
Me.ShowAllData
With Range("J6:J150006")
.CurrentRegion.Sort Range("J7"), Header:=xlYes
.ClearContents
End With
Target = vbNullString
Application.ScreenUpdating = True
MsgBox "Es wurden " & Format(Zeilen, "#,##0") & " Datensätze von 150.000 gelöscht!" & vbLf & _
"Die Aktion dauerte " & Format(Timer - Start, "0.00 sec.")
End If
End If
EvOn:
With Application
.EnableEvents = True
.Calculation = OldCalc
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
|