Hallo, ich versuche ein Makro zu schreiben, das eine riesige Datei verarbeitet (30-35.000 Zeilen). Ich habe eine Schleife, die alle Zellen in Spalte A durchläuft und alle Zeilen löscht, in denen das Datum in Spalte A nicht dem gestrigen Datum entspricht. (klingt verworren, ich weiß). Gibt es eine effizientere Möglichkeit, dies zu tun? Ich meine, die Schleife funktioniert, aber sie stürzt häufig ab und läuft ab usw.

Sub PSAudit()
Dim Auditdate As String
Dim rng As Range
Dim psm as worksheet

Set psm = Sheets("PS_MAIN")
Application.ScreenUpdating = False

        Auditdate = Format(Date - 1, "yyyy-mm-dd")

    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    For x = 1 To lastrow

        If psm.Range("A" & x).Value <> Auditdate Then psm.Range("A" & x).EntireRow.Delete

    Next x


Application.ScreenUpdating = True


End Sub
0
Rhyfelwr 18 Apr. 2018 im 14:45

5 Antworten

Beste Antwort

Sie müssen ganz unten beginnen, da nach dem Löschen einer Zeile Ihr Index um eine Zeile entfernt ist. Sie sollten das Blatt auch wirklich für Ihre LastRow Abfrage qualifizieren. Sie sind sich auch nicht sicher, warum Sie rng deklarieren, da Sie es nicht verwenden. Zuletzt würde ich die Berechnung deaktivieren, wenn die Arbeitsmappe Formeln enthält.

Sub PSAudit()

    Dim Auditdate As String
    Dim psm As Worksheet

    Set psm = Sheets("PS_MAIN")
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Auditdate = Format(Date - 1, "yyyy-mm-dd")

    lastrow = psm.Cells(Rows.Count, "A").End(xlUp).Row

      For x = lastrow To 1 Step -1
          With psm.Range("A" & x)
              If .Value <> Auditdate Then .EntireRow.Delete
          End With
      Next x

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub
1
CLR 18 Apr. 2018 im 12:05

Ich würde folgendes tun:

Sub PSAudit()
    Dim psm As Worksheet
    Set psm = ThisWorkbook.Sheets("PS_MAIN")
    Dim LastRow As Long
    Dim Auditdate As String
    Auditdate = Format(Now() - 1, "yyyy-mm-dd")
    Application.Calculation = xlCalculationManual
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    For x = LastRow To 1 Step -1
        If psm.Cells(x, 1).Value <> Auditdate Then
            psm.Cells(x, 1).EntireRow.Delete
        End If
        DoEvents
    Next x
    Application.Calculation = xlCalculationAutomatic
End Sub

Erläuterung: Wenn Sie zum Löschen von Zeilen (oder Spalten) ein for next verwenden, beginnen Sie zunächst von unten. Zweitens stürzt Ihre Datei nicht ab, wenn Sie ein DoEvents in die Prozedur einfügen. Und drittens können Sie durch die Verwendung vollständiger Zellenadressen an Ihrer Datei (auch auf anderen Blättern) oder sogar an anderen Arbeitsmappen arbeiten, während Ihr Skript ausgeführt wird.

1
Pspl 18 Apr. 2018 im 12:01

Wenn Sie die Antwort @ingwarus erweitern, ist es schneller, alle Zeilen auf einmal zu löschen, wenn Sie ihre Adresse angeben.

Sub PSAudit()
    Dim Auditdate As String
    Dim rng As Range
    Dim psm As Worksheet
    Dim vArr(), i As Long
    Dim auStart As Long, auEnd As Long

    DisFun False

    Set psm = ThisWorkbook.Worksheets("PS_MAIN")
    Auditdate = Format(Date - 1, "yyyy-mm-dd")
    Set rng = psm.Range("A1:D" & Range("A" & psm.Rows.Count).End(xlUp).Row)
    'Set rng = psm.Range("A1").CurrentRegion
    rng.Sort rng.Cells(1, 1), xlAscending, , , , , , xlNo
    vArr = Application.Transpose(rng.Columns("A").Value)
    For i = LBound(vArr) To UBound(vArr)
        If vArr(i) = Auditdate Then auStart = i: Exit For
    Next i
    For i = UBound(vArr) To LBound(vArr) Step -1
        If vArr(i) = Auditdate Then auEnd = i: Exit For
    Next i
    Select Case True
        'Auditdate is at start
        Case auStart = 1
            psm.Range(auEnd + 1 & ":" & UBound(vArr)).EntireRow.Delete
        'Auditdate is at the end
        Case auEnd = UBound(vArr)
            psm.Range("1:" & auStart - 1).EntireRow.Delete
        'Auditdate in between
        Case Else
            psm.Range("1:" & auStart - 1 & "," & auEnd + 1 & ":" & UBound(vArr)).EntireRow.Delete
    End Select

    DisFun True

End Sub

Zunächst müssen wir den Bereich definieren und sortieren.
Zweitens müssen wir das erste und letzte Vorkommen von AuditDate finden.
Abhängig von den Werten auStart und auEnd können wir bestimmte Situationen eingrenzen und Zeilen entsprechend löschen.
Ich habe Hilfe verwendet, die man in späteren Projekten nützlich finden kann:

Private Sub DisFun(ByVal Status As Boolean)
    With Application
        .ScreenUpdating = Status
        .EnableEvents = Status
        .DisplayStatusBar = Status
        .Calculation = IIf(Status, -4105, -4135)
    End With
End Sub
1
AntiDrondert 18 Apr. 2018 im 19:17

Die Verwendung von .Find() ist immer erheblich schneller als das Durchlaufen aller Zeilen (für alle bis auf eine geringfügige Anzahl von Zeilen).

Dies ist nicht getestet, sollte aber den Einstieg erleichtern. Sie müssen wahrscheinlich den Parameter What:="" ein wenig anpassen und damit herumspielen. Es ist viel einfacher, wenn Sie nach etwas Bestimmtem suchen, als nach etwas, das nicht ist. Ich würde vorschlagen, Ihre Suche über das Dialogfeld zu verfeinern, um genau zu bestimmen, was Sie in den Parameter What:="" eingeben müssen.

Denken Sie daran, dass .Find() alle Sucheinstellungen verwendet, die im Dialogfeld "Benutzeroberfläche" definiert sind, es sei denn, Sie geben sie in Ihrem Code an, und ändern sie im Code Sie sehen auch im Dialogfeld.

Private Sub PSAudit()

  On Error GoTo cleanExit
  Dim auditDate As Date
  auditDate = Date

  Dim previousCalculation As Long
  previousCalculation = Application.Calculation
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

  Dim psm As Worksheet
  Set psm = ActiveWorkbook.Worksheets("PS_MAIN")
  Dim searchRange As Range
  Set searchRange = psm.Columns("A")

  Dim oldDates As Range
  Set oldDates = psm.Columns.Find(What:="< auditDate", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)

  If not oldDates is Nothing then
    Dim deleteRow As Range
    For Each deleteRow In oldDates
      deleteRow.EntireRow.Delete
    Next
 End If

cleanExit:
  Application.ScreenUpdating = True
  Application.Calculation = previousCalculation

End Sub

Das Ausschalten von .ScreenUpdating und .Calculation, wie von anderen erwähnt, verbessert die Verarbeitungszeiten etwas, aber .Find() ist der große Schlagmann.

0
FreeMan 18 Apr. 2018 im 12:55

Das zeilenweise Löschen ist schmerzhaft langsam. Sie sollten daher nach Datum sortieren und alle Zeilen gleichzeitig löschen. Es ist der schnellste Weg.

-2
ingwarus 18 Apr. 2018 im 12:06