Zelle rot färben wen x und nach 50 minuten x löschen und grün färben

Question

hallo leute bräuchte  wieder eure hilfe

habe in zellen a1 - a50 namen stehen.

nun schreibe ich in zb.in zelle E1 ein x nun soll sich die zelle a1 dann rot färben aber nach 50 minuten soll das x gelöscht werden und sich die zelle grün färben genau so soll es dann weiter gehen bis runder zu  a50 bz e50

den jeder spieler von a1 bis a50 kann nur nacheinander starten und erst wieder nach 50 minuten einen 2 versuch machen ich markiere ihn in e mit einen x so das ich weis das er schon drann war

hoffe es kann mir jemand helfen bedanke mich schon mal .. wen aber der aufwand zu große ist dann lassen wir es ..

Answer 1

Hallo bischoff2000,

hier:
https://learn.microsoft.com/de-de/answers/questions/4841518/excel-zeitstempel-in-zelle-bei-aktion-in-nachbarze
findest du ein Makro, das in einer Nachbarzelle den aktuellen Zeitstempel bei einer Eingabe schreibt.

Damit kannst du über Vergleich dieses Zeitstempels mit der aktuellen Zeit eine Formel für bedingte Formatierung der Eingabezelle erstellen. Ich gehe aber davon aus, dass die bedingte Formatierung immer dann aktualisiert wird, wenn in der Tabelle irgend etwas geändert wird, also nicht automatisch nach Ablauf der Zeit.

Alternativ kannst du mit Application.OnTime ein Makro nach Abklauf einer bestimmten Zeit starten und damit die Formatierung der Zelle ändern. Näheres dazu hier:
https://excel-inside.de/beispiele_vba/vba-ereignisse/259-ausfuehren-eines-makros-nach-einer-definierten-wartezeit

Gruß computerschrat

Answer 2

Einzufügen : Alt + F11 / Projektexplorer / Deine Tabelle

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E1:E50")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If LCase(Target.Value) = "x" Then
If WorksheetFunction.CountIf(Range("E1:E50"), "x") > 1 Then
Target.ClearContents: MsgBox "Nur 1 Spieler gleichzeitig."
Else
Cells(Target.Row, "A").Interior.Color = vbRed
StartRowTimer Target.Row
End If
Else
Cells(Target.Row, "A").Interior.Pattern = xlNone
CancelRowTimer
End If
Application.EnableEvents = True
End Sub

Einzufügen : Alt + F11 / Einfügen Modul

Public activeRow As Long
Public dueTime As Date
Public scheduled As Boolean

Sub StartRowTimer(ByVal r As Long)
On Error Resume Next
If scheduled Then Application.OnTime dueTime, "RowTimeUp", , False
activeRow = r
dueTime = Now + TimeSerial(0, 50, 0)
scheduled = True
Application.OnTime dueTime, "RowTimeUp"
End Sub

Sub CancelRowTimer()
On Error Resume Next
If scheduled Then Application.OnTime dueTime, "RowTimeUp", , False
scheduled = False
End Sub

Sub RowTimeUp()
With ThisWorkbook.Worksheets("Tabelle1")
If LCase(.Cells(activeRow, "E").Value) = "x" Then
Application.EnableEvents = False
.Cells(activeRow, "E").ClearContents
.Cells(activeRow, "A").Interior.Color = vbGreen
Application.EnableEvents = True
End If
End With
scheduled = False
End Sub