Thema Datum  Von Nutzer Rating
Antwort
Rot Zellen finden
08.08.2024 11:11:11 Hady
NotSolved
08.08.2024 12:05:15 Gast41106
NotSolved
08.08.2024 12:45:04 ralf_b
NotSolved

Ansicht des Beitrags:
Von:
Hady
Datum:
08.08.2024 11:11:11
Views:
306
Rating: Antwort:
  Ja
Thema:
Zellen finden

Hallo Zusammen,

In Spalte 1 ab Zeile 19 stehen Namen z.B. Max Mustermann. Dieser Name kann auch öfters vorkommen. Ab Spalte 7 Zeile 18 sind die Daten für einen variablen Monat eingetragen. Ab Spalte 7 Zeile 19 können in unterschiedlichen Zeilen und Spalten (also für eine Person und an verschiedenen Daten eine Uhrzeit wie "07:00" eingetragen sein. Wenn für die gleiche Person an gleichen Tagen eine Uhrzeit eingetragen ist, sollen die beiden Zellen gelb markiert werden.

Mein Ansatz:

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
    
    ' Setze das Arbeitsblatt
    Set ws = ThisWorkbook.Sheets("Main") ' Passe den Blattnamen an
    
    ' Anfangszeile und -spalte
    startRow = 19
    startCol = 7
    
    ' Ende der Zeilen und Spalten (dynamisch ermittelt)
    endRow = ws.Cells(ws.Rows.count, 1).End(xlUp).Row
    endCol = ws.Cells(18, ws.Columns.count).End(xlToLeft).Column
    
    ' Initialisiere das Dictionary
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' Durchlaufe die Namen und Daten
    For i = startRow To endRow
        person = ws.Cells(i, 1).value
        
        For j = startCol To endCol
            ZellInhalt = ws.Cells(i, j).value
            
            ' Überprüfe, ob der Zellinhalt eine Uhrzeit ist und nicht leer ist
            If IsTime(ZellInhalt) Then
                ' Schlüssel für das Dictionary erstellen
                key = person & "_" & ws.Cells(18, j).value & "_" & Format(ZellInhalt, "hh:mm")
                
                ' Überprüfe, ob der Schlüssel bereits existiert
                If dict.exists(key) Then
                    ' Hole die gespeicherte Position
                    dictValue = dict(key)
                    ' Stelle sicher, dass die gespeicherte Position auch eine Uhrzeit enthält
                    If IsTime(ws.Cells(dictValue(0), dictValue(1)).value) Then
                        ' Markiere beide Zellen gelb
                        ws.Cells(i, j).Interior.Color = RGB(255, 255, 0) ' Gelb
                        ws.Cells(dictValue(0), dictValue(1)).Interior.Color = RGB(255, 255, 0) ' Gelb
                    End If
                Else
                    ' Füge den Schlüssel und die Zellposition zum Dictionary hinzu
                    dict.Add key, Array(i, j)
                End If
            End If
        Next j
    Next i
End Sub

Function IsTime(value As Variant) As Boolean
    ' Prüfe, ob der Wert eine gültige Uhrzeit im Excel-Format ist
    Dim tempTime As Date
    On Error Resume Next
    tempTime = TimeValue(value)
    IsTime = (Err.Number = 0)
    On Error GoTo 0
End Function

Leider klappt der Code nicht, da, wenn eine Uhrzeit eingetragen ist "07:00" nicht erkannt also IsTime =false ist. Kann mir jemand helfen, was ich hier verändern muss, bitte?
Vielen Dank

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Zellen finden
08.08.2024 11:11:11 Hady
NotSolved
08.08.2024 12:05:15 Gast41106
NotSolved
08.08.2024 12:45:04 ralf_b
NotSolved