AW: Daten in Abhängigkeit eines Datums auslesen
26.11.2008 15:50:00
fcs
Hallo Robert,
das lässt sich per Formel meines Wissens nicht mehr so ohne weiteres lösen.
Deshalb mein Vorschlag die Liste per Makro zu erstellen.
Denke daran, dass Excel 2003 "nur" 255 Spalten zur Verfügung hat.
Du kannst allso nicht alle Tage eines Jahres in einer Tabelle unterbringen.
Wenn du weniger als 255 Mitarbeiter verwalten willst, dann ist es ggf. besser, die Mitarbeiternamen in den Spalten und die Kalendertage in den Zeilen einzugeben.
Das Makro muss man dann auch entsprechend komplett umstellen.
Gruß
Franz
Sub Fehlt()
Dim wksDaten As Worksheet
Dim wksFehlt As Worksheet
Dim datDatum As Date
Dim lngFehlt As Long 'Zeilenzähler im Blatt wksFehlt
Dim lngData As Long 'Zeilenzähler im Blatt wksDaten
Dim SpalteTag As Long 'Spalte des gsuchten Datums
Dim lngSpalte As Long 'Spaltenzähler
'Konstanten für Zeilen und Spalten im Fehlt-Blatt
Const TitelFehlt As Long = 7 'Zeile mit Titeln
Const SpNameFehlt As Long = 2 'Spalte mit Namen
'Konstanten für Zeilen und Spalten im Daten-Kalender Blatt
Const ZeileDatum As Long = 3 'Zeile mit Datum
Const SpalteJan1 As Long = 7 'Spalte mit 1. Januar
Const SpalteName As Long = 4 'Spalte mit Namen
Const ZeileName1 As Long = 5 '1. Zeile mit Namen
Set wksDaten = Worksheets("Tabelle1")
Set wksFehlt = Worksheets("Tabelle2")
With wksFehlt
'Altdaten unterhalb Titelzeile löschen
.Range(.Rows(TitelFehlt + 1), _
.Rows(.Cells(TitelFehlt + 1, 2).End(xlDown).Row)).ClearContents
datDatum = .Range("F1") 'Stichtag
lngFehlt = TitelFehlt 'Zeile mit Spaltentiteln
End With
With wksDaten
'Spalte mit gewünschtem Datum in Zeile 3 ermitteln
For lngSpalte = SpalteJan1 To .Cells(ZeileDatum, .Columns.Count).End(xlToLeft).Column
If .Cells(ZeileDatum, lngSpalte).Value = datDatum Then
SpalteTag = lngSpalte
Exit For
End If
Next
If SpalteTag = 0 Then
MsgBox "Datum " & datDatum & " nicht gefunden im Blatt " & .Name
GoTo Beenden
End If
'Spalte mit Mitarbeiternamen abarbeiten
For lngData = ZeileName1 To .Cells(.Rows.Count, SpalteName).End(xlUp).Row
'Eintrag des Mitarbeiters für den Tag prüfen
Select Case .Cells(lngData, SpalteTag).Value
Case "K", "F", "U" 'Einträge die als Fehlt gelten
lngFehlt = lngFehlt + 1
'Namen ins Fehlt-Blatt eintragen
wksFehlt.Cells(lngFehlt, SpNameFehlt).Value = .Cells(lngData, SpalteName).Value
'1. Arbeitstag nach Fehlt-Tag ermitteln
For lngSpalte = SpalteTag To .Cells(ZeileDatum, .Columns.Count).End(xlToLeft).Column
Select Case .Cells(lngData, lngSpalte).Value
Case "K", "F", "U" 'Einträge die als Fehlt gelten
'do nothing, fehlt weiterhin
Case ""
'Prüfen auf Sa oder So
If Weekday(.Cells(ZeileDatum, lngSpalte)) = vbSaturday Or _
Weekday(.Cells(ZeileDatum, lngSpalte)) = vbSunday Then
'do nothing
'Prüfen auf Feiertag an Hand er Zellfarbe
ElseIf .Cells(lngData, lngSpalte).Interior.ColorIndex = 45 Then
'Feiertag
'do nothing
Else
'Datum in Fehlt-Blatt eintragen
wksFehlt.Cells(lngFehlt, SpNameFehlt + 1).Value = _
.Cells(ZeileDatum, lngSpalte).Value
Exit For
End If
Case Else
'Arbeitet wieder, anderer Eintrag der nicht als fehlt gilt
'Datum in Fehlt-Blatt eintragen
wksFehlt.Cells(lngFehlt, SpNameFehlt + 1).Value = _
.Cells(ZeileDatum, lngSpalte).Value
End Select
Next
Case Else
'anderere Einträge der nicht als fehlt gilt
'do nothing
End Select
Next
End With
Beenden:
End Sub