Clever-Excel-Forum

Hallo liebe Leute ich möchte gerne wie in der Tabelle hier eingefügt ist das ich wenn ich auf den Start Button oben drücken eine Message Box aufgeht und mir der Artikel mit S-Nummer und Bondprogramm angezeigt wird die älter als Jahr ist! Danach möchte ich sagen Ok dann wird in der Zelle Erstellungsdatum das Datum raus glöscht oder mit einem Abbrech Button das ganze abgebrochen. Der soll die Liste so lange durch gehen bis er keine Datum mehr findet was älter ein Jahr ist und mir das auch anzeigt!
Ganz unten ist meine Formel funktionierte auch mal aber irgendwie funktioniert sie nicht mehr richtig! Könnt ihr mír helfen??

Artikel    S-Nummer    Bondprogramm     Ordner Erstellungsdatum Name geprüft
aa S8888     62222,00 Bondprogramme 21.01.2017 ew    Ok

aaa S8888 22447,00 Bondprogramme 22.02.2015 ew OK

bbb S87404 652141,00           Bondprogramme 21.01.2017 ew Ok

Private Sub Start_Click()

Dim sh As Worksheet
Dim lz As Long
Dim ct As Long
Set sh = Worksheets("Del. 1")
With sh
lz = .Cells(.Cells.Rows.Count, 5).End(xlUp).Row
ct = 5
Do
If DateAdd("yyyy", 1, .Cells(ct, 5)) < Date Then

.Cells(ct, 5).Activate

    If MsgBox(" Letzte Aktualisierung für" & vbLf & _
     "     " & .Cells(ct, 1) & "    " & vbLf & _
     "     älter als ein Jahr" & vbLf & vbLf & _
     "    Eintrag löchen ?", vbYesNoCancel) = 6 Then
    .Cells(ct, 5).ClearContents
    lz = .Cells(.Cells.Rows.Count, 5).End(xlUp).Row

End If
End If
ct = ct + 1
Loop While ct - 1 < lz

End With
End Sub

Hola,

http://www.excel-ist-sexy.de/forenhilfe/eilt-wichtig/

Ich sehe keinen Anhang.

Gruß,
steve1da

Hallo,

was bedeutet: "funktioniert nicht mehr richtig"?

Ich kann mir Vorstellen, dass sich der Code unnötig mit leeren Zellen herumschlägt.
Deswegen würde ich noch eine Prüfung auf leer und Datum einbauen.

Zwei Zeilen mehr in Deinem Code:

Code:
Private Sub Start_Click()

Dim lz As Long

Dim ct As Long

With Worksheets("Del. 1")

  lz = .Cells(.Cells.Rows.Count, 5).End(xlUp).Row

  ct = 5

  Do

'    If .Cells(ct, 5) <> "" And IsDate(.Cells(ct, 5)) Then 'zusätzliche Prüfung

      If DateAdd("yyyy", 1, .Cells(ct, 5)) < Date Then

        .Cells(ct, 5).Activate

        If MsgBox(" Letzte Aktualisierung für" & vbLf & _

          "     " & .Cells(ct, 1) & "    " & vbLf & _

          "     älter als ein Jahr" & vbLf & vbLf & _

          "    Eintrag löchen ?", vbYesNoCancel) = 6 Then

          .Cells(ct, 5).ClearContents

          lz = .Cells(.Cells.Rows.Count, 5).End(xlUp).Row

        End If

      End If

'    End If   'Ende der zusätzlichen Prüfung

    ct = ct + 1

  Loop While ct - 1 < lz

End With

End Sub

Oder

Code:
Sub M_snb()

    sn = Array(69, 105, 108, 101, 32, 109, 105, 116, 32, 87, 101, 105, 108, 101)

    For j = 0 To UBound(sn)

      sn(j) = Chr(sn(j))

    Next

    MsgBox Join(sn, "")

End Sub

und....

Code:
Sub M_ati()

    at = Array(87, 111, 32, 98, 108, 101, 105, 98, 116, 32, 68, 101, 105, 110, 101, 32, 115, 99, 104, 110, 101, 108, 108, 101, 32, 86, 101, 114, 115, 105, 111, 110, 63)

    For j = 0 To UBound(at)

      at(j) = Chr(at(j))

    Next

    MsgBox Join(at, "")

End Sub

Hola,

zur Info...

http://www.vba-forum.de/forum/View.aspx?...eure_Hilfe

Gruß,
steve1da

Creativ87

steve1da

atilla

snb

atilla

steve1da