Hallo,
ich habe das Makro angepasst:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngMonat As Long
Dim lngLSpalte As Long
Dim lngLZeile As Long
Dim arrMitarbeiter()
Dim lngZeile As Long
Dim lngSpalte As Long
Dim lngAnzahl As Long
Dim lngZaehler As Long
'Falls keine Eingabe in C2 erfolgt dann Makro verlassen
If Target.Address <> "$C$2" Then Exit Sub
'Meldungen ausschalten
Application.EnableEvents = False
'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False
'Inhalte Blatt Personalliste löschen
With Worksheets("Personalliste").Range("A7", Cells(Application.Max(7, Cells(Rows.Count, 1).End(xlUp).Row), 1)).Resize(, 8)
.ClearContents 'Inhalte löschen
.ClearComments 'Kommentar löschen
End With
With Worksheets("Ressourcenplan")
'letzte Spalte in Zeile 3 des Arbeitsblatts Ressourcenplan ermitteln ermitteln
lngLSpalte = .Cells(3, Columns.Count).End(xlToLeft).Column
'Letzte Zeile in Spalte C ermitteln
lngLZeile = .Cells(Rows.Count, 3).End(xlUp).Row
'Monat zur Auswertung bestimmen
Select Case Range("C2").Value
Case Is = "Jänner"
lngMonat = 1
Case Is = "Februar"
lngMonat = 2
Case Is = "März"
lngMonat = 3
Case Is = "April"
lngMonat = 4
Case Is = "Mai"
lngMonat = 5
Case Is = "Juni"
lngMonat = 5
Case Is = "Juli"
lngMonat = 6
Case Is = "August"
lngMonat = 8
Case Is = "September"
lngMonat = 9
Case Is = "Oktober"
lngMonat = 10
Case Is = "November"
lngMonat = 11
Case Is = "Dezember"
lngMonat = 12
End Select
'ggf im Arbeitsblatt vorhandene Filter aufheben
If .FilterMode Then .ShowAllData
'nun nach aktiven Mitarbeitern in Spalte C filtern
With .Range(.Cells(20, 3), .Cells(lngLZeile, 3))
.AutoFilter Field:=1, Criteria1:="=aktiv"
End With
'Anzahl der gefilterten Datensätze ermitteln
For lngZeile = 21 To lngLZeile
If .Cells(lngZeile, 3).Value = "aktiv" Then lngAnzahl = lngAnzahl + 1
Next lngZeile
'Feld für Auswertung Redimensionieren
ReDim arrMitarbeiter(lngAnzahl, 8)
'nun gefilterte Zeilen durchlaufen und Daten in Feld einlesen
For lngZeile = 21 To lngLZeile
If .Rows(lngZeile).Hidden = False Then
lngZaehler = lngZaehler + 1
arrMitarbeiter(lngZaehler, 0) = .Cells(lngZeile, 1) 'Nummer des Mitarbeiters - Spalte A
arrMitarbeiter(lngZaehler, 1) = .Cells(lngZeile, 2) 'Name des Mitarbeiters - Spalte B
'Stunden des jeweiligen Monats suchen
For lngSpalte = 5 To lngLSpalte
If .Cells(20, lngSpalte) = Worksheets("Personalliste").Range("C2").Value Then
arrMitarbeiter(lngZaehler, 2) = .Cells(lngZeile, lngSpalte) 'Arbeitsstunden im Monat
Exit For
End If
Next lngSpalte
'nun Feiertage, Urlaub und Krank des Monats zählen
'dazu wieder alles Spalten durchlaufen
'zuerst wird geprüft, ob in Zeile 3 ein Datum stehn
For lngSpalte = 5 To lngLSpalte
If IsDate(.Cells(3, lngSpalte)) = True Then
'nun prüfen, ob Datum in dem gesuchten Monat liegt
If Month(.Cells(3, lngSpalte)) = lngMonat Then
'falls ja, dann prüfen, ob etwas in der betreffenden Spalte steht und entsprechenden Zähler erhöhen
If .Cells(lngZeile, lngSpalte).Value = "FT" Then
arrMitarbeiter(lngZaehler, 3) = arrMitarbeiter(lngZaehler, 3) + 1 'Feiertag
arrMitarbeiter(lngZaehler, 6) = arrMitarbeiter(lngZaehler, 6) & Chr(10) & .Cells(3, lngSpalte) 'Datum des Feiertages
End If
If .Cells(lngZeile, lngSpalte).Value = "UR" Then
arrMitarbeiter(lngZaehler, 4) = arrMitarbeiter(lngZaehler, 4) + 1 'Urlaub
arrMitarbeiter(lngZaehler, 7) = arrMitarbeiter(lngZaehler, 7) & Chr(10) & .Cells(3, lngSpalte)
End If
If .Cells(lngZeile, lngSpalte).Value = "KH" Then
arrMitarbeiter(lngZaehler, 5) = arrMitarbeiter(lngZaehler, 5) + 1 'Krank
arrMitarbeiter(lngZaehler, 8) = arrMitarbeiter(lngZaehler, 8) & Chr(10) & .Cells(3, lngSpalte)
'hier werden noch die Soll-Stunden für die Krankheitstage zu den Ist-Stunden addiert, Montag - Donnerstag je 8,5 Std. und Freitag 5 Stunden
If Weekday(.Cells(3, lngSpalte), vbMonday) < 5 Then arrMitarbeiter(lngZaehler, 2) = arrMitarbeiter(lngZaehler, 2) + 8.5
If Weekday(.Cells(3, lngSpalte), vbMonday) = 5 Then arrMitarbeiter(lngZaehler, 2) = arrMitarbeiter(lngZaehler, 2) + 5
End If
End If
End If
Next lngSpalte
End If
Next lngZeile
'Filter wieder aufheben
With .Range(.Cells(20, 3), .Cells(lngLZeile, lngLSpalte))
.AutoFilter
End With
End With
'Nun Daten in Personalliste übertragen
With Worksheets("Personalliste")
For lngZeile = 1 To lngZaehler
For lngSpalte = 0 To 5
With .Cells(lngZeile + 6, lngSpalte + 1)
.Value = arrMitarbeiter(lngZeile, lngSpalte)
'Daten der Fehlzeiten als Kommentar einfügen
If lngSpalte > 2 And arrMitarbeiter(lngZeile, lngSpalte + 3) <> "" Then
.AddComment
.Comment.Visible = False
.Comment.Text Text:=arrMitarbeiter(lngZeile, 1) & Chr(10) & Right(arrMitarbeiter(lngZeile, lngSpalte + 3), Len(arrMitarbeiter(lngZeile, lngSpalte + 3)) - 1) 'Daten als Kommentar ausgeben
With .Comment.Shape.TextFrame
.AutoSize = True
End With
End If
End With
Next lngSpalte
Next lngZeile
End With
'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True
'Meldungen wieder anzeigen
Application.EnableEvents = True
End Sub
In deiner Testdatei funktioniert es so jedenfalls.
In C3 werden ja schon die Stunden aus dem Ressourcenplan ausgegeben. Wird diese Zahl dann nicht mehr benötigt? Wenn du die Soll-Arbeitsstunden per Makro zählen willst, ist das etwas aufwendig, da du ja für jedes Jahr die beweglichen Feiertage berechnen musst.Und auch die festen Feiertage müssen natürlich entsprechend hinterlegt werden. Das ist im Prinzip alles machbar, aber dann muss ich erst mal überlegen, wie man das am Besten löst.
Gruß
M.O.
