Thema: bestimmte Zellen einfärben | Herbers Excel-Forum

Hallo,
ich möchte, dass sich bestimmte Zellen in Spalte A ab A13 grau einfärben. Welche Zellen das betrifft, ergibt sich aus A1-B12. Um es besser zu verdeutlichen, habe ich es in Tabelle2 so dargestellt, wie es im Ergebnis aussehen sollte.
https://www.herber.de/bbs/user/66277.xls
Danke für eure Hilfe.
Gruß
Karsten

Hallo,
müsste es gehen.
https://www.herber.de/bbs/user/66278.xls
Gruß Tino

Hallo Tino,
danke...noch nicht ganz. Die Daten die dazwischen liegen, sollten ebenfalls grau sein.
Wo finde ich den Befehl-ich möchte noch einiges anpassen?
Gruß
Karsten

Hallo,
die Regel findest Du in xl2007 unter Start Bedingte Formatierung Regeln Verwalten
Um immer von bis Datum zu gehen wirst Du wahrscheinlich mehrere Bedingungen anlegen müssen,
weil die Formellänge in der Bedingten Formatierung begrenzt ist,
wie die Begrenzung jetzt aussieht weiß ich auch nicht.
In der Form
1. Bedingung
=ODER(($A13>=$A$1)*($A13<=$B$1);($A13>=$A$2)*($A13<=$B$2))
2. Bedingung
=ODER(($A13>=$A$3)*($A13<=$B$3);($A13>=$A$4)*($A13<=$B$4))
usw... bis A12 u. B12
sollte unter xl2007 kein Problem darstellen.
Gruß Tino

Hallo,
schau mal unter Format Bedingte Formatierung nach,
die Formel müsstest Du so bauen damit Du mit drei Bedingungen aus kommst.
Gruß Tino

Hallo Tino,
kannst du mit der Möglichkeit (siehe Antwort auf Chris) etwas anfangen?
Gruß
Karsten

Hallo,
habe alles in drei Bedingungen unter gebracht.
https://www.herber.de/bbs/user/66298.xls
Gruß Tino

Hallo,
und mit Summenprodukt
=SUMMENPRODUKT(($A13>=$A$1:$A$12)*($A13<=$B$1:$B$12)*($A13<>""))
https://www.herber.de/bbs/user/66300.xls
Gruß Tino

Hallo Tino,
danke, aber das wird mir alles nicht weiterhelfen, da ich nun weiß, dass bed. Formatierungen von VBA "nicht ohne weiteres" erkannt werden.
Wenn du mir weiterhelfen möchtes, siehe bitte den Beitrag "Colorindex 15 ungleich Colorindex 15" AW Hajo und meine AW darunter.
Gruß
Karsten

Hallo,
kann den unterschied der Markierungen zwar nicht erkennen bzw. warum es VBA sein muss,
dennoch hier Deinen angepassten Code der die Daten von B2 bis C12 in Spalte A markiert.

Sub Markieren_Ferien()
Dim lngStart As Long, lngEnd As Long, varRes As Variant
Dim varArRange(10) As Variant
Dim A As Long

With Application
 .ScreenUpdating = False
    With Sheets("Lehrbericht")
        .Columns(1).Interior.ColorIndex = xlColorIndexNone
        
        'Zellen von B2 bis C12 
        For A = 2 To 12
         Set varArRange(A - 2) = .Range(.Cells(A, 2), .Cells(A, 3))
        Next A
          
        For A = Lbound(varArRange) To Ubound(varArRange)
          With varArRange(A)
            If IsDate(.Cells(1, 1).Value) And IsDate(.Cells(1, 2).Value) Then
              varRes = Application.Match(.Cells(1, 1).Value2, Sheets("Lehrbericht").Range("a:a"), 0)
              If IsNumeric(varRes) Then lngStart = varRes
              varRes = Application.Match(.Cells(1, 2).Value2, Sheets("Lehrbericht").Range("a:a"), 0)
              If IsNumeric(varRes) Then lngEnd = varRes
            End If
          End With
          
            If lngStart > 0 And lngEnd > 0 Then
                .Range(.Cells(lngStart, 1), .Cells(lngEnd, 1)).Interior.ColorIndex = 15
            End If
        Next A
    End With
 .ScreenUpdating = True
End With
End Sub

Gruß Tino

Hallo,
so ist der Code bestimmt verständlicher und auch einfacher.

Sub Markieren_Ferien()
Dim lngStart As Long, lngEnd As Long, varRes As Variant
Dim A As Long
Dim rngRange As Range

With Application
 .ScreenUpdating = False
    With Sheets("Lehrbericht")
        .Columns(1).Interior.ColorIndex = xlColorIndexNone
        
        'Zellen von B2 bis C12 
        Set rngRange = .Range("B2:C12")
          
        For A = 1 To rngRange.Rows.Count
          
            If IsDate(rngRange(A, 1).Value) And IsDate(rngRange(1, 2).Value) Then
              varRes = Application.Match(rngRange(A, 1).Value2, .Range("a:a"), 0)
              If IsNumeric(varRes) Then lngStart = varRes
              varRes = Application.Match(rngRange(A, 2).Value2, .Range("a:a"), 0)
              If IsNumeric(varRes) Then lngEnd = varRes
            End If

          
            If lngStart > 0 And lngEnd > 0 Then
                .Range(.Cells(lngStart, 1), .Cells(lngEnd, 1)).Interior.ColorIndex = 15
            End If
        Next A
    End With
 .ScreenUpdating = True
End With
End Sub

Gruß Tino

Hallo Tino,
ja, so kann ich mit meinen bescheidenen Kenntnissen daraus was machen.
Danke.
Gruß
Karsten

Hallo Tino,
danke.
Wenn ich in C nach unten erweitern möchte, müsste ich da nur die 12 ändern?
For A = 2 To 12
Gruß
Karsten

Hallo Tino,
danke.
Gruß
Karsten

Hi,
unter Format & Bedingte Formatierung kannst du sowas einstellen.
Anbei: Tabelle 1 sollte deine Wünschen entsprechen:
https://www.herber.de/bbs/user/66280.xls

Hallo Chris,
danke, aber bei mir sind nur 3 Bedingungen möglich.
Mir hat mal jemand netterweise diesen Code geschrieben (für B2undC2). Unten drunter habe ich noch mal dasselbe mit B3 und C3 gemacht. Mir ist das ganze aber in dieser Ausstattung zulang. Kannst du diesen Code optisch schön schrumpfen und so dass er auch für mehr Zeilen (B4 und C4 usw...) anpassbar wird?
Gruß
Karsten

Sub Markieren_Ferien()
Dim lngStart As Long, lngEnd As Long, varRes As Variant
With Sheets("Lehrbericht")
If IsDate(.Range("b2")) And IsDate(.Range("c2")) Then
varRes = Application.Match(.Range("b2"), Sheets("Lehrbericht").Range("a:a"), 0)
If IsNumeric(varRes) Then lngStart = varRes
varRes = Application.Match(.Range("c2"), Sheets("Lehrbericht").Range("a:a"), 0)
If IsNumeric(varRes) Then lngEnd = varRes
End If
End With
If lngStart > 0 And lngEnd > 0 Then
With Sheets("Lehrbericht")
.Range(.Cells(lngStart, 1), .Cells(lngEnd, 1)).Interior.ColorIndex = 15
End With
End If
Dim lngStart1 As Long, lngEnd1 As Long, varRes1 As Variant
With Sheets("Lehrbericht")
If IsDate(.Range("b3")) And IsDate(.Range("c3")) Then
varRes1 = Application.Match(.Range("b3"), Sheets("Lehrbericht").Range("a:a"), 0)
If IsNumeric(varRes1) Then lngStart1 = varRes1
varRes1 = Application.Match(.Range("c3"), Sheets("Lehrbericht").Range("a:a"), 0)
If IsNumeric(varRes1) Then lngEnd1 = varRes1
End If
End With
If lngStart1 > 0 And lngEnd1 > 0 Then
With Sheets("Lehrbericht")
.Range(.Cells(lngStart1, 1), .Cells(lngEnd1, 1)).Interior.ColorIndex = 15
End With
End If
End Sub