Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Code automatisch ausführen lassen
#1
Hallo miteinander,

ich habe vor einiger Zeit bereits eine Anfrage zu diesem Thema erstellt, bei der mir super geholfen wurde! An dieser Stelle noch einmal vielen Dank dafür!
Mein damaliges "Problem" ist aber leider noch nicht in Gänze gelöst und ich kann aufgrund meiner sehr geringen VBA-Kenntnisse trotz Google-Marathon leider
nicht selbst für Abhilfe sorgen. Aus diesem Grunde möchte ich Euch noch einmal um Unterstützung bitten:

Folgender Code soll dafür Sorge tragen, dass, sobald ein Datum in einer Zelle in Spalte "L" eingetragen wird, ein Eintrag in einer Zelle in Spalte "B" nach Ablauf von 40 Tagen gelöscht wird.
Beim jetzigen Code ist es so, dass dies funktioniert, wenn ich eine Datum eingebe das "Heute - 40 Tage" entspricht. Ich hätte es aber gern so, dass beim Öffnen der Liste geprüft wird, ob
in Spalte "L" Daten sind, die (basierend auf dem eingegebenen Datum) älter als 40 Tage sind und wenn ja, die jeweiligen Einträge in Spalte "B" gelöscht werden. Wenn in "L" keine Daten sind, soll nichts passieren.
Also einfach eine Automatisierung.
Hier ist der jetzige Code (dank an Schauan & Case!):

Option Explicit
Private Sub Worksheet_change(ByVal Target As Range)
    Dim rngRange As Range
    On Error GoTo Fin
    Application.EnableEvents = False
    If Not Intersect(Target, Columns("L")) Is Nothing Then
        For Each rngRange In Target
            If DateDiff("d", rngRange.Value, Date) > 40 And Trim(rngRange.Offset(, -10).Value) <> "" Then
                rngRange.Offset(, -10).Value = ""
            End If
        Next rngRange
    End If
Fin:    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description
End Sub


Würde mich freuen, wenn jemand helfen kann!

Danke und beste Grüße
Tom
Antwortento top
#2
Hallo,

Tabellenblattname anpassen und Code ins Codemodul von "DieseArbeitsmappe" kopieren.
Code:
Option Explicit

Private Sub Workbook_Open()
Dim i As Long, raWeg As Range

On Error GoTo Fin
Application.EnableEvents = False

With Worksheets("Tabelle1")
    For i = 1 To .Cells(.Rows.Count, "L").End(xlUp).Row
        If .Cells(i, "L") <> "" Then
            If IsDate(.Cells(i, "L")) Then
                If DateDiff("d", .Cells(i, "L"), Date) > 40 And Trim(.Cells(i, "B")) <> "" Then
                    If raWeg Is Nothing Then
                        Set raWeg = .Cells(i, "B")
                    Else
                        Set raWeg = Union(raWeg, .Cells(i, "B"))
                    End If
                End If
            End If
        End If
    Next i
    If Not raWeg Is Nothing Then
        raWeg.ClearContents
    End If
End With

Set raWeg = Nothing
         
Fin:    Application.EnableEvents = True
If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description
End Sub

Gruß Werner
[-] Folgende(r) 1 Benutzer sagt Danke an Werner.M für diesen Beitrag:
  • Tom 002
Antwortento top
#3
Thumbs Up 
Hallo Werner,

funktioniert einwandfrei! Super! Vielen Dank für die Hilfe!!!

Beste Grüße
Tom
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste