Bedingte Formatierung, jeden 4 Freitag kennzeichnen

  • #1
N

nok106

Bekanntes Mitglied
Themenersteller
Dabei seit
10.09.2005
Beiträge
108
Reaktionspunkte
0
Ort
Brunsbüttel
Hallo,

Frage:

besteht die Möglichkeit, mit der Bedingten Formatierung, jeden 4. Freitag, in den Monaten des lfd. Jahres
zu markieren.

Wenn ja, bitte ich um Hilfe

Ich habe es mit folgender Formel versucht, aber Pustekuchen !!!

=UND(REST(ZÄHLENWENN(A6:R31;Fr);4)=0
 
  • #2
Hallo nok106,

wie ist denn dein Kalender aufgebaut, welche Spalten, Zeilen gibt es, welche inhalte haben die Zellen ?

Gruß Matjes :)
 
  • #3
Ich hab dir einen kleinen Kalender-Makro gebaut, der jeden 4. Freitag im Jahr kennzeichnet.

Gruß Matjes :)
Code: 
Sub KalenderAusfuellen()
  Const cZ_ERSTEDATUMSZEILE = 2
  Const cCOLORINDEXWOCHENENDE = 6
  Const cCOLORINDEX4TEFREITAG = 12
  
  Dim ws As Worksheet
  Dim lJahr As Long, dDate As Date, lAnzFreitage As Long, sMonat As String
  Dim Monate As Variant, m As Long, t As Long, b As Long
  Dim lWochentag As Long, sWochentag As String, lFarbe As Long
  
  Monate = Array(Januar, Februar, März, April, Mai, Juni, Juli, _
                 August, September, Oktober, November, Dezember)

  
 ->neues Blatt in activer Mappe anlegen
  Set ws = ActiveWorkbook.Worksheets.Add
  
 ->aktuelles Jahr bestimmen
  lJahr = Year(Now)
  
 ->Datum auf den 31.12 des Vorjahres initialisieren
  dDate = 1 & . & 1 & . & lJahr
  dDate = dDate - 1
  
 ->Freitagszähler
  lAnzFreitage = 0
  
 ->alle Monate
  For m = 1 To 12
   ->Monatsüberschrift
    With ws.Cells(cZ_ERSTEDATUMSZEILE - 1, m)
      .Value = Monate(m - 1)
      .Font.Bold = True
      For b = 7 To 10
        With .Borders(b)
          .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
      Next
    End With
    
   ->alle Tage, wenn vorhanden
    For t = 1 To 31
      dDate = dDate + 1
      If Month(dDate) = m Then
        lWochentag = WeekDay(dDate)
        Select Case lWochentag
          Case 1: sWochentag = So: lFarbe = cCOLORINDEXWOCHENENDE
          Case 2: sWochentag = Mo: lFarbe = xlColorIndexNone
          Case 3: sWochentag = Di: lFarbe = xlColorIndexNone
          Case 4: sWochentag = Mi: lFarbe = xlColorIndexNone
          Case 5: sWochentag = Do: lFarbe = xlColorIndexNone
          Case 6: sWochentag = Fr: lFarbe = xlColorIndexNone
                  lAnzFreitage = lAnzFreitage + 1
                  If lAnzFreitage Mod 4 = 0 Then lFarbe = cCOLORINDEX4TEFREITAG
          Case 7: sWochentag = Sa: lFarbe = cCOLORINDEXWOCHENENDE
        End Select
        With ws.Cells(t + cZ_ERSTEDATUMSZEILE - 1, m)
          .Value = Format(t, #0) &   & sWochentag
          .Interior.ColorIndex = lFarbe
          For b = 7 To 10
            With .Borders(b)
              .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
            End With
          Next
        End With
      Else
        dDate = dDate - 1: Exit For
      End If
    Next
  Next
  
  With ws.PageSetup
   ->Überschrift, fett, Schriftgröße 14
    .CenterHeader = &B&14Jahreskalender  & lJahr
   ->A4
    .PaperSize = xlPaperA4
   ->Querformat
    .Orientation = xlLandscape
   ->eine Seite breit
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 200
  End With
End Sub
 
  • #4
Hallo Matjes,

besten Dank für deine Antwort und den Kalendercode.

Hier meine Daten:

1.Halbjahr = A5:L36
2.Halbjahr = N5:Y36
A6 = DATUM(j;1;ZEILE()-5)
B6 = WENN(ISTFEHLER(SVERWEIS(A6;$B$38:$C$59;2;0));;SVERWEIS(A6;$B$38:$C$59;2;0))
C6 und D6
E6 und F6 usw.

Die Wochenenden und Feiertage habe ich über Bedingte Formatierung gekennzeichnet.

Der Kalender wird in DIN A5 erstellt.
 
  • #5
Kannst Du mir den mal schicken ? Dann schau ich mal was sich machen läßt.

Gruß Matjes :)
 
  • #6
Hallo Matjes,

der Kalender funktioniert einwandfrei.

Nur die Frage ist von mir blöd gestellt worden, ich bitte um Entschuldigung.

Ich meine nicht jeden 4. Freitag, sondern den letzten Freitag eines Monats.

Ist dieses auch machbar ?
 
  • #7
so ?
Gruß Matjes :)
Code: 
Sub KalenderAusfuellen2()
  Const cZ_ERSTEDATUMSZEILE = 2
  Const cCOLORINDEXWOCHENENDE = 6
  Const cCOLORINDEX4TEFREITAG = 12
  
  Dim ws As Worksheet
  Dim lJahr As Long, dDate As Date, lAnzFreitage As Long, sMonat As String
  Dim Monate As Variant, m As Long, t As Long, b As Long
  Dim lWochentag As Long, sWochentag As String, lFarbe As Long
  Dim tLetzterFreitag As Long
  
  Monate = Array(Januar, Februar, März, April, Mai, Juni, Juli, _
                 August, September, Oktober, November, Dezember)

  
 ->neues Blatt in activer Mappe anlegen
  Set ws = ActiveWorkbook.Worksheets.Add
  
 ->aktuelles Jahr bestimmen
  lJahr = Year(Now)
  
 ->Datum auf den 31.12 des Vorjahres initialisieren
  dDate = 1 & . & 1 & . & lJahr
  dDate = dDate - 1
  
 ->Freitagszähler
  lAnzFreitage = 0
  
 ->alle Monate
  For m = 1 To 12
   ->Monatsüberschrift
    With ws.Cells(cZ_ERSTEDATUMSZEILE - 1, m)
      .Value = Monate(m - 1)
      .Font.Bold = True
      For b = 7 To 10
        With .Borders(b)
          .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
      Next
    End With
    
   ->alle Tage, wenn vorhanden
    For t = 1 To 31
      dDate = dDate + 1
      If Month(dDate) = m Then
        lWochentag = Weekday(dDate)
        Select Case lWochentag
          Case 1: sWochentag = So: lFarbe = cCOLORINDEXWOCHENENDE
          Case 2: sWochentag = Mo: lFarbe = xlColorIndexNone
          Case 3: sWochentag = Di: lFarbe = xlColorIndexNone
          Case 4: sWochentag = Mi: lFarbe = xlColorIndexNone
          Case 5: sWochentag = Do: lFarbe = xlColorIndexNone
          Case 6: sWochentag = Fr: lFarbe = xlColorIndexNone
            tLetzterFreitag = t->merken
          Case 7: sWochentag = Sa: lFarbe = cCOLORINDEXWOCHENENDE
        End Select
        With ws.Cells(t + cZ_ERSTEDATUMSZEILE - 1, m)
          .Value = Format(t, #0) &   & sWochentag
          .Interior.ColorIndex = lFarbe
          For b = 7 To 10
            With .Borders(b)
              .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
            End With
          Next
        End With
      Else
        dDate = dDate - 1: Exit For
      End If
    Next
   ->letzten gemerkten Freitag im Monat farbig setzen
    ws.Cells(tLetzterFreitag + cZ_ERSTEDATUMSZEILE - 1, _
             m).Interior.ColorIndex = cCOLORINDEX4TEFREITAG
  Next
  
  With ws.PageSetup
   ->Überschrift, fett, Schriftgröße 14
    .CenterHeader = &B&14Jahreskalender  & lJahr
   ->A4
    .PaperSize = xlPaperA4
   ->Querformat
    .Orientation = xlLandscape
   ->eine Seite breit
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 200
  End With
End Sub
 
  • #8
Hallo Matjes,

für den Kalendercode 2 besten Dank,
zwischenzeitlich wurde mein Problem gelöst.

Folgender Code, in der Bedingten Formatierung, eingegeben und alles ist paletti.
Somit kann ich meinen Kalender weiterhin benutzen, und meine blöde formalierte Eingangsfrage ist damit gelöst.

Code: 
=UND(TAG(A6)>TAG(DATUM(JAHR(A6);MONAT(A6)+1;))-7;WOCHENTAG(A6;2)=5)

Für deine Bemühungen nochmal besten Dank.
 
Thema:

Bedingte Formatierung, jeden 4 Freitag kennzeichnen

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums

Themen
113.838
Beiträge
707.961
Mitglieder
51.491
Neuestes Mitglied
haraldmuc
Oben