Sub MarkiereDoppelteUhrzeiten()
Dim ws As Worksheet
Dim startRow As Long, startCol As Long
Dim endRow As Long, endCol As Long
Dim i As Long, j As Long
Dim person As String
Dim dict As Object
Dim ZellInhalt As Variant
Dim key As String
Dim dictValue As Variant
Set ws = ThisWorkbook.Sheets("Main")
startRow = 19
startCol = 7
endRow = ws.Cells(ws.Rows.count, 1).End(xlUp).Row
endCol = ws.Cells(18, ws.Columns.count).End(xlToLeft).Column
Set dict = CreateObject("Scripting.Dictionary")
For i = startRow To endRow
person = ws.Cells(i, 1).value
For j = startCol To endCol
ZellInhalt = ws.Cells(i, j).value
If IsTime(ZellInhalt) Then
key = person & "_" & ws.Cells(18, j).value & "_" & Format(ZellInhalt, "hh:mm")
If dict.exists(key) Then
dictValue = dict(key)
If IsTime(ws.Cells(dictValue(0), dictValue(1)).value) Then
ws.Cells(i, j).Interior.Color = RGB(255, 255, 0)
ws.Cells(dictValue(0), dictValue(1)).Interior.Color = RGB(255, 255, 0)
End If
Else
dict.Add key, Array(i, j)
End If
End If
Next j
Next i
End Sub
Function IsTime(value As Variant) As Boolean
Dim tempTime As Date
On Error Resume Next
tempTime = TimeValue(value)
IsTime = (Err.Number = 0)
On Error GoTo 0
End Function