AW: Kalender - Nachfrage
01.01.2005 17:29:26
Klaus-Dieter
Hallo Dirk,
um dir das Verstehen zu erleichtern, hier das Makro mit Kommentaren:
Sub ferientermin()
' Variablen deklarieren
Dim s, sp As Integer
Dim spp As Integer
Dim z, zz As Integer
Dim such As Date
Dim suchz As Date
Dim farb As Integer
' Termine einlesen
For sp = 4 To 2 Step -2 ' Einlesen mit Niedersachsen beginnen
If sp = 4 Then farb = 40 Else farb = 36 ' wenn Niedersachsen dann Farbe = orage sonst hellgelb
For s = 3 To Worksheets("Ferientermine"). _
Range("B65536").End(xlUp).Row ' Schleife von Zeile 3 bis letzte Zeile mit Termin (Ferientermine einlesen)
If Worksheets("Ferientermine").Cells(s, sp) <> "" Then ' wenn Termin vorhanden, dann ...
such = Format(Worksheets("Ferientermine"). _
Cells(s, sp), "dd.mm.yyyy") ' ... einlesen im Datumformat (Ferienbeginn)
suchz = Format(Worksheets("Ferientermine"). _
Cells(s, sp + 1), "dd.mm.yyyy") ' ... einlesen im Datumformat (Ferienende)
End If ' Ende einlesen
zz = 3
' Termine im Kalender suchen und markieren
Do While Worksheets("Kalender").Cells(zz, 2) <> such ' suchen, bis Starttermin gefunden
zz = zz + 1 ' Schleifenzähler plus 1
Loop ' laufen bis Termin gefunden
zz = zz - 1 ' Schleifenzähler minus eins (Fehlerkorrektur)
Do While Worksheets("Kalender").Cells(zz, 2) <> suchz ' laufen bis Endtermin gefunden
zz = zz + 1 ' Schleifenzähler plus 1
' Zellen markieren
For spp = 1 To 22 ' Laufe duch Spalte A bis V
If Cells(zz, spp).Interior.ColorIndex < 0 Then ' wenn Zelle nicht gefärbt, dann ...
Cells(zz, spp).Interior.ColorIndex = farb ' ... Ferientermin kennzeichnen (Farbe nach Land, NRW hat Priorität)
End If ' Ende färben
Next spp ' Schleifenzähler plus 1, neuer Lauf beginnt
Loop ' laufen, solange Ferien sind
Next s ' Schleifenzähler plus 1, neuen Ferientermin feststellen
Next sp ' Schleifenzähler minus 2, (Wechsel des Bundeslandes)
End
Sub ' Ende des Makros
<br>Gruß Klaus-Dieter<br>
<a href="http://home.arcor.de/excelseite/Index.html"><img src="http://home.arcor.de/excelseite/Images/banner.gif" width=233 height=67 border=0 alt="Klaus-Dieter's Excel und VBA Seite">