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.

VBA Problem
#1
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
.xlsm   Test.xlsm (Größe: 41,7 KB / Downloads: 1)
Antworten Top
#2
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
Gruß der AlteDresdner (Win11, Off2021)
[-] Folgende(r) 1 Nutzer sagt Danke an AlterDresdner für diesen Beitrag:
  • Maximus
Antworten Top
#3
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
.xlsm   Test.xlsm (Größe: 42,24 KB / Downloads: 1)
Antworten Top
#4
Danke nochmal!
Habe für mich eine andere Lösung gefunden!

Gruss Markus
Antworten Top
#5
Magst du die auch mitteilen? Ist ja immerhin auch Sinn eines Forums Wink
[-] Folgende(r) 1 Nutzer sagt Danke an steve1da für diesen Beitrag:
  • derHoepp
Antworten Top
#6
Hi,

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

Viele Grüße
derHöpp
Antworten Top


Gehe zu:


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