Office: Zellen mit bestimmter Formatierung mit Makro zählen

Hallo,

wir haben im Büro einen Urlaubsplaner in Excel realisiert. Das heisst, eine einfaches Arbeitsblatt mit einem Kalender. Jeder der Kollegen markiert seine Urlaubstage mit seiner Farbe.
Die Anzahl der Urlaubstage lasse ich mit einem Makro zählen:

Code:

For Each zelle In Range("B4:X36")
    If zelle.Interior.Color = RGB(251, 203, 155) Then
    tobias = tobias + 1
        ElseIf zelle.Interior.Color = RGB(180, 214, 172) Then
        juergen = juergen + 1
            ElseIf zelle.Interior.Color = RGB(137, 194, 229) Then
            pedro = pedro + 1
    End If
Next zelle

Für den Fall, dass an einem Tag zwei Urlaub haben, haben wir in der Tabelle die Zelle entsprechend formatiert mit einem Muster (breite längsstreifen).
Jetzt möchte ich die gerne nach oberem Beispiel dazu addieren.
Aber ich kenne den Interior.xxx Befehl nicht um die Farbe der Musterung abzufragen.
Ich denke es geht irgendwie mit Interior.Pattern oder so ähnlich.

Danke & Gruß,
Tobias

 

Hi Tobias,

ungetestet: versuche es mal mit zelle.Interior.PatternColor

Bis später,
Karin

 

Hallo,

das war leider nicht erfolgreich, zumindest nicht mit meiner RGB-Wert Suchmethode.
Oder muss ich die Art und Weise der Musterung (bei mir dicke horizontaleStreifen) mit berücksichtigen?

Gruß,
Tobias

 

Hi Tobias,

und wie sieht dein jetziger Code denn aus? Ein hochgeladenes Beispiel mit Dummydaten wäre sicher auch hilfreich.

Bis später,
Karin

 

Hallo,

also mein Code sieht jetzt so aus:

Code:

For Each zelle In Range("B4:X36")
    If zelle.Interior.Color = RGB(251, 203, 155) Then
    tobias = tobias + 1
    ElseIf zelle.Interior.PatternColor = RGB(251, 203, 155) Then
    tobias = tobias + 1
        ElseIf zelle.Interior.Color = RGB(180, 214, 172) Then
        juergen = juergen + 1
        ElseIf zelle.Interior.PatternColor = RGB(180, 214, 172) Then
        juergen = juergen + 1
            ElseIf zelle.Interior.Color = RGB(137, 194, 229) Then
            pedro = pedro + 1
            ElseIf zelle.Interior.PatternColor = RGB(180, 214, 172) Then
            pedro = pedro + 1
    End If
Next zelle

Datei habe ich auch angehängt.

 

Hi Tobias,

versuche es mal so:

Code:

Sub daycount()
    Dim rngZelle As Range
    Dim tobias As Integer
    Dim juergen As Integer
    Dim pedro As Integer
    Set rngZelle = ActiveCell
    For Each zelle In Union(Range("B6:H11"), Range("J6:P11"), Range("R6:X11"), _
        Range("B15:H20"), Range("J15:P20"), Range("R15:X20"), _
        Range("B24:H28"), Range("J24:P28"), Range("R24:X28"), _
        Range("B32:H36"), Range("J32:P36"), Range("R32:X36"))    'Range("B4:X36")
        If zelle.MergeCells = False Then
            zelle.Select
            If zelle.Interior.Color = 10079487 Then tobias = tobias + 1
            If zelle.Interior.PatternColor = 10079487 Then tobias = tobias + 1
            If zelle.Interior.Color = 52377 Then juergen = juergen + 1
            If zelle.Interior.PatternColor = 52377 Then juergen = juergen + 1
            If zelle.Interior.Color = 13421619 Then pedro = pedro + 1
            If zelle.Interior.PatternColor = 13421619 Then pedro = pedro + 1
        End If
    Next zelle
    'MsgBox ("Bitte in den folgenden Feldern die zusätzlichen Urlaubstage eintragen wo die Excel Zelle gemustert ist (Sekundär Farbe!)")
    'tobias = tobias + InputBox("Zusätzliche Urlaubstage für Tobias?", "Tobias Frings")
    'juergen = juergen + InputBox("Zusätzliche Urlaubstage für Jürgen?", "Jürgen Richartz")
    'pedro = pedro + InputBox("Zusätzliche Urlaubstage für Pedro?", "Pedro Antonio")
    
    Range("B38") = "P. Antonio: " & pedro & " Tage Urlaub"
    Range("J38") = "J. Richartz: " & juergen & " Tage Urlaub"
    Range("R38") = "T. Frings: " & tobias & " Tage Urlaub"
    rngZelle.Select
    Application.Wait Now + TimeValue("00:00:01")
    Set rngZelle = Nothing
End Sub

Das Problem ist generell, dass bei der Schnelligkeit des Codedurchlaufs Excel offenbar Probleme hat, die Farbe für die Variable juergen korrekt auszulesen - weshalb auch immer, denn im Einzelschrittmodus wird sie korrekt ermittelt. Abhilfe schafft, die Zelle zu selektieren, die Bildschirmaktualisierung darfst du im Code allerdings nicht abschalten.

Ich habe mal noch den Bereich für das Auslesen etwas eingeschränkt, indem ich nur die Bereiche der einzelnen Monate überprüfen lasse und nicht den gesamten Bereich B4:X36 - kannst du ja bei Bedarf wieder zurücknehmen.

Bis später,
Karin