Dim buchstabe(1 To 750) As String
Dim bis_hier As Long
Dim nummer(1 To 500) As Integer
Dim Teilnehmer(1 To 500) As String
Dim X_en(1 To 500) As Integer

Sub delete_x()
    Range("D6:D1000").Select
    Selection.ClearContents
    Range("A1").Select
End Sub


Sub filter_kalender()
aktueller_name = ActiveSheet.Name
k = 1
For i = 1 To 200
ofs = 5
zeile = i + ofs
nummer(i) = ActiveWorkbook.Worksheets(aktueller_name).Range("B" & zeile).Value
Teilnehmer(i) = ActiveWorkbook.Worksheets(aktueller_name).Range("C" & zeile).Value
X_wert = ActiveWorkbook.Worksheets(aktueller_name).Range("D" & zeile).Value
If X_wert = "x" Then
    X_en(k) = nummer(i)
    k = k + 1
End If
Call spalten_buchstaben_schreiben
ActiveWorkbook.Worksheets("kalender").Range(buchstabe(i + 3) & CStr(5)).Value = Teilnehmer(i)
Next i
Sheets("kalender").Select
Call alles_ausblenden
Call x_en_einblenden
For i = 1 To 200
    X_en(i) = 0
Next i
Range("A6").Select
End Sub

Sub x_en_einblenden()
For i = 1 To 200
    If X_en(i) = 0 Then
        ' nichts tun
    Else
        Call ein_teilnehmer_einblenden(X_en(i))
    End If
Next i
End Sub
Sub ein_teilnehmer_einblenden(nummer As Integer)
    element = nummer + 3
    Call spalten_buchstaben_schreiben
    Columns(buchstabe(element) & ":" & buchstabe(element)).Select
    Selection.EntireColumn.Hidden = False
End Sub
Sub alles_einblenden()
    Columns("A:ZZ").Select
    Selection.EntireColumn.Hidden = False
End Sub
Sub alles_ausblenden()
    Sheets("kalender").Select
    Columns("D:ZZ").Select
    Selection.EntireColumn.Hidden = True
End Sub

Sub kalender_erzeugen()
Dim erster_tag_date As Date
Dim erster_tag_long As Long
Dim letzter_tag_date As Date
Dim letzter_tag_long As Long
aktueller_name = ActiveSheet.Name
erster_tag_date = ActiveWorkbook.Worksheets(aktueller_name).Range("B1").Value
erster_tag_long = CLng(erster_tag_date)
letzter_tag_date = ActiveWorkbook.Worksheets(aktueller_name).Range("B2").Value
letzter_tag_long = CLng(letzter_tag_date)
rest = erster_tag_long Mod 7
bis_hier = letzter_tag_long - erster_tag_long
For Tag = erster_tag_long To letzter_tag_long
    zeile = Tag - (erster_tag_long - 1) + (rest + 5)
    ActiveWorkbook.Worksheets(aktueller_name).Range("B" & zeile).Value = Tag
Next Tag
Columns("B:B").Select
Selection.NumberFormat = "[$-x-sysdate]dddd, mmmm dd, yyyy"
Call streifen(65535, 6)
Call streifen(65535, 7)
Call bedingte_formatierung
Range("A1").Select
End Sub

Sub streifen(farbe_als_uebergabe As Long, starte_hier As Integer)
For i = starte_hier To (bis_hier + 7) Step 7
    Rows(i & ":" & i).Select
    With Selection.Interior
        .Color = farbe_als_uebergabe
    End With
Next i
End Sub

Sub bedingte_formatierung()
    Columns("A:A").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=""heute"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub









Sub spalten_buchstaben_schreiben()

Dim alph2(0 To 26) As String

alph2(0) = ""
alph2(1) = "A"
alph2(2) = "B"
alph2(3) = "C"
alph2(4) = "D"
alph2(5) = "E"
alph2(6) = "F"
alph2(7) = "G"
alph2(8) = "H"
alph2(9) = "I"
alph2(10) = "J"
alph2(11) = "K"
alph2(12) = "L"
alph2(13) = "M"
alph2(14) = "N"
alph2(15) = "O"
alph2(16) = "P"
alph2(17) = "Q"
alph2(18) = "R"
alph2(19) = "S"
alph2(20) = "T"
alph2(21) = "U"
alph2(22) = "V"
alph2(23) = "W"
alph2(24) = "X"
alph2(25) = "Y"
alph2(26) = "Z"


' init
y_ = 0
Z_ = 0
n = 1
m = 1
k = 0
aktueller_name = ActiveSheet.Name
For i = 1 To 702
ofs = 26
If i > n * 26 Then
    n = n + 1
    Z_ = 0
    y_ = y_ + 1
End If
Z_ = Z_ + 1
buchstabe(i) = alph2(y_) & alph2(Z_)
'ActiveWorkbook.Worksheets(aktueller_name).Range("A" & i).Value = buchstabe(i)
Next i

End Sub