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