Hier das Listing !!!
08.03.2005 09:05:11
Fred
Sub Samstage_zaehlen()
Dim Samstage As Worksheet
Dim Ergebnis As Worksheet
Dim Name As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Anzahl As Integer
Dim Heute As Date
'Damit kann ich einfacher auf die Arbeitsblätter zugreifen
Set Samstage = ThisWorkbook.Worksheets("Samstage")
Set Ergebnis = ThisWorkbook.Worksheets("Ergebnis")
'Das Arbeitsblatt "Ergebnis" wird angezeigt
Ergebnis.Select
'Zelle B3 wird markiert
Range("B3").Select
'i, j und k sind Zählvariablen und werden zu Anfang mit 0 initialisiert
i = 0
j = 0
k = 0
'Anzahl ist die Zahl die ermittelt werden soll. Sie ist zu Anfang auch 0
Anzahl = 0
'Das heutige Datum wir ermittelt
Heute = Range("A3").Value
'Der erste Name der Ergebnisliste wird ermittelt
Name = Range("B3").Cells.Offset(i, 0).Value
'Die Namensliste wird durchgegangen, bis kein Name mehr dasteht
While Name <> "" And Name <> "usw."
'Jetzt wird in der Namensliste bei den Samstagen gesucht
Samstage.Select
Name2 = Range("C3").Cells.Offset(0, j).Value
While Name2 <> ""
'Wenn der gleiche Name gefunden wird
If Name2 = Name Then
'Jetzt wird die Spalte nach unten durchgegangen bis zum Datum, das Heute am nächsten ist
While Range("B4").Cells.Offset(k, 0) < Heute
'Wenn in der Spalte ein x gefunden wird, wird die Anzahl auf 0 zurückgesetzt
'ansonsten wird die Anzahl um 1 erhöht.
If Range("C4").Cells.Offset(k, j) = "x" Then
Anzahl = 0
Else
Anzahl = Anzahl + 1
End If
'Der Zähler wird um 1 erhöht, damit die nächste Zelle in der Spalte gelesen werden kann
k = k + 1
Wend
'k muss neu initialisiert werden
k = 0
End If
'Der Zähler wird um 1 erhöht, damit der nächste Name bei den Samstagen ermittelt werden kann
j = j + 1
'Der nächste Name bei den Samstagen wird ermittelt
Name2 = Range("C3").Cells.Offset(0, j).Value
Wend
'Die Anzahl wurde ermittelt und wird jetzt eingetragen
Ergebnis.Select
Range("B3").Cells.Offset(i, 1).Value = Anzahl
'Der Zähler wird um 1 erhöht, damit der nächste Name in der Ergbniliste ermittelt werden kann
i = i + 1
'j muss neu initialisiert werden
j = 0
'Anzahl muss auch zurückgesetzt werden
Anzahl = 0
'Der nächste Name in der Ergebnisliste wird ermittelt
Name = Range("B3").Cells.Offset(i, 0).Value
Wend
End Sub