Clever-Excel-Forum

Hallo,

AA2 soll mit der Spalte AF verglichen werden. Wenn Übereinstimmung, dann in
AA4 "erledigt" und in AA18 "beendet" für ein paar Sekunden dann wieder weg.) Klappt leider nicht.
Weiss wer warum nicht?

Code:
Sub MarkAsCompleted()

    Dim ws As Worksheet

    Dim LastRow As Long

    Dim Cell As Range

    Dim TargetValue As Variant

    ' Ändern Sie den Blattnamen und den Zielwert entsprechend.

    Set ws = ThisWorkbook.Sheets("GEWINNER")

    TargetValue = ws.Range("AA2").Value

    LastRow = ws.Cells(ws.Rows.Count, "AF").End(xlUp).Row

    Dim flag As Boolean

    flag = False

    Application.ScreenUpdating = False ' Bildschirmaktualisierung deaktivieren

    For Each Cell In ws.Range("AF2:AF" & LastRow)

        If Cell.Value = TargetValue Then

            flag = True

            Exit For ' Beenden Sie die Schleife, wenn ein übereinstimmender Wert gefunden wurde.

        End If

    Next Cell

    If flag Then

        ws.Range("AA4").Value = "erledigt"

        ws.Range("AA18").Value = "beendet"

        Application.OnTime Now + TimeValue("00:00:05"), "RemoveMarkings"

    Else

        ws.Range("AA4").ClearContents

        ws.Range("AA18").ClearContents

    End If

    Application.ScreenUpdating = True ' Bildschirmaktualisierung wieder aktivieren

End Sub

Sub RemoveMarkings()

    ' Ändern Sie den Blattnamen entsprechend.

    ThisWorkbook.Sheets("GEWINNER").Range("AA4").ClearContents

    ThisWorkbook.Sheets("GEWINNER").Range("AA18").ClearContents

End Sub

Danke für die Hilfe!

Gruss Markus[attachment=49747]

Hallo Markus,
statt Ontime...

Code:
Sub MsgZeit()

'   Blendet eine Msgbox nach 3 Sekunden automatisch wieder aus

'   von K.Rola L.Vira

'   kein Verweis notwendig

    Const bytZeit As Byte = 3

    Dim objWSH As Object, intMSG As Integer

    Set objWSH = CreateObject("WScript.Shell")

    intMSG = objWSH.Popup("Ich bin in " & bytZeit & " Sekunden verschwunden! Variante 2" & Space(10), bytZeit, "gebe bekannt...")

    Set objWSH = Nothing

End Sub

Hallo AlterDresdner,

ich habe versucht mit Hilfe von chatgpt, weil zu schlechte Kenntnisse, daraus einen code zu machen:

Code:
Sub VergleicheUndAnzeigen()

    Dim ws As Worksheet

    Dim LastRow As Long

    Dim Cell As Range

    Dim TargetValue As Variant

    ' Ändern Sie den Blattnamen und den Zielwert entsprechend.

    Set ws = ThisWorkbook.Sheets("GEWINNER")

    TargetValue = ws.Range("AA2").Value

    LastRow = ws.Cells(ws.Rows.Count, "AF").End(xlUp).Row

    Dim flag As Boolean

    flag = False

    Application.ScreenUpdating = False ' Bildschirmaktualisierung deaktivieren

    For Each Cell In ws.Range("AF2:AF" & LastRow)

        If Cell.Value = TargetValue Then

            flag = True

            Exit For ' Beenden Sie die Schleife, wenn ein übereinstimmender Wert gefunden wurde.

        End If

    Next Cell

    If flag Then

        ws.Range("AA4").Value = "erledigt"

        ws.Range("AA18").Value = "beendet"

        ' Hier wird die MsgBox-Prozedur aufgerufen, um die Nachricht anzuzeigen.

        Call MsgZeit

    Else

        ws.Range("AA4").ClearContents

        ws.Range("AA18").ClearContents

    End If

    Application.ScreenUpdating = True ' Bildschirmaktualisierung wieder aktivieren

End Sub

Sub MsgZeit()

    ' Blendet eine MsgBox nach 3 Sekunden automatisch wieder aus

    ' von K.Rola L.Vira

    ' kein Verweis notwendig

    Const bytZeit As Byte = 3

    Dim objWSH As Object, intMSG As Integer

    Set objWSH = CreateObject("WScript.Shell")

    intMSG = objWSH.Popup("Ich bin in " & bytZeit & " Sekunden verschwunden! Variante 2" & Space(10), bytZeit, "gebe bekannt...")

    Set objWSH = Nothing

End Sub

Leider keine Funktion. Aber auch keine Fehlermeldung.

Könntest du so nett sein und den kompletten Code einmal reinzukopieren.

Viiielen Dank!

Markus[attachment=49749]

Danke nochmal!
Habe für mich eine andere Lösung gefunden!

Gruss Markus

Magst du die auch mitteilen? Ist ja immerhin auch Sinn eines Forums Wink

Hi,

wenn du noch dazuschreibst, was deine alternative Lösung ist, können alle davon etwas lernen.

Viele Grüße
derHöpp

Maximus

AlterDresdner

Maximus

Maximus

steve1da

derHoepp