Ich bin neu in VBA. Ich habe aber etwas Erfahrung in VBS.
In meiner Tabelle gibt es eine Spalte Datum. Mehrere Zeilen können das gleiche Datum beinhalten. Sobald ich die Arbeitsmappe öffne, sollen die Datensätze (Zeilen), die älter als 20 Tage sind, automatisch löscht werden. Außerdem sollen Datensätze ab den fünften Tag besonders gekennzeichnet werden, wenn bestimmte Spalten leer sind. Mit der Löschfunktion habe ich hier meine Schwierigkeiten und weiß keinen Rat mehr.
Was musst ich tun, nachdem das Makro die gesamte Zeile gelöscht hat?
Vielen Dank im Voraus.
Hier ist mein Versuch.
Option Explicit
Sub test()
Const LoeschenNach As Integer = 20
Const MeldenNach As Integer = 5
Dim Eingangsdatum As Date
Dim Heute As Date
Dim SuchBereich As Range
Dim IstDatum As Boolean
Dim i As Long
Dim j As Long
Heute = Date
' Bildschirmaktualisierung deaktivieren (Beschleunigt die Makroauführung)
Application.ScreenUpdating = False
' Verwendete Zeilen zählen
i = ThisWorkbook.ActiveSheet.UsedRange.Rows.Count
' Den zu durchsuchende Bereich festlegen
Set SuchBereich = ThisWorkbook.ActiveSheet.Range("I1:I" & i)
' I | J | K
' Datum | E-Mail am | Brief am
' Durch den Suchbereich iterieren
For j = 1 To SuchBereich.Count
' Fehlerbehandlung aktivieren
On Error Resume Next
IstDatum = False
' Kann der Zellenwert in "Date" konvertiert werden?
Eingangsdatum = CDate(SuchBereich(j).Value)
If Err.Number = 0 Then
IstDatum = True
End If
' Fehlerbehandlung deaktivieren
On Error GoTo 0
If IstDatum Then
' Meldung nach fünf Tage verschicken!
If (DateDiff("d", Eingangsdatum, Heute) > MeldenNach) Then
If IsEmpty(Range("J" & j).Value) And IsEmpty(Range("K" & j).Value) Then
Range("J" & j & ":K" & j).Interior.Color = vbYellow
Range("J" & j).Value = "Bitte E-Mail versenden!"
Range("K" & j).Value = "Bitte Brief verschicken!"
End If
End If
' Datensatz nach 20 Tagen löschen.
If (DateDiff("d", Eingangsdatum, Heute) > LoeschenNach) Then
SuchBereich(j).EntireRow.Delete
' j = j - 1 !!! ENDLOSSCHLEIFE !!!
End If
End If
Next j
' Bildschirmaktualisierung aktivieren
Application.ScreenUpdating = True
End Sub