Hallo,
ich habe den Fehler gefunden und das Makro entsprechend geändert. Die Fehlermeldung ist dadurch entstanden, dass zuerst die Anzahl der aktiven Mitarbeiter gezählt wurde, um dann das Datenfeld zu dimensionieren, in das die Daten (Name, Nr., Fehlzeiten) geschrieben werden. Danach wurden alle nicht ausgeblendeten Zeilen durchlaufen, um die entsprechenden Daten zu ermitteln. Ist am Ende noch eine Leerzeile (z.B. mit Rahmen), dann wollte das Makro noch ein Datensatz in das "volle" Datenfeld geschrieben werden, was zu einer Fehlermeldung und dem Abbruch geführt hat. (Klassischer Fall von Betriebsblindheit )
Ich habe jetzt die Filterung weggelassen und es werden nur die Datensätze in das Feld übernommen, deren Status aktiv ist. Jetzt sollte das Makro auch in deiner großen Datei funktionieren:
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
Dim sinSollstunden As Single
'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
'Anzahl der aktiven Mitarbeiter ermitteln
For lngZeile = 21 To lngLZeile
If .Cells(lngZeile, 4).Value = "aktiv" Then lngAnzahl = lngAnzahl + 1
Next lngZeile
'Feld für Auswertung Redimensionieren
ReDim arrMitarbeiter(lngAnzahl, 8)
'nun Zeilen durchlaufen und Daten in Feld einlesen
For lngZeile = 21 To lngLZeile
If .Cells(lngZeile, 4).Value = "aktiv" Then
lngZaehler = lngZaehler + 1
arrMitarbeiter(lngZaehler, 0) = .Cells(lngZeile, 2) 'Nummer des Mitarbeiters - Spalte B
arrMitarbeiter(lngZaehler, 1) = .Cells(lngZeile, 3) 'Name des Mitarbeiters - Spalte 3
'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
'Soll-Stunden ermitteln - ohne Berücksichtigung von Feiertagen
If lngZaehler = 1 Then
If Weekday(.Cells(3, lngSpalte), vbMonday) < 5 Then sinSollstunden = sinSollstunden + 8.5
If Weekday(.Cells(3, lngSpalte), vbMonday) = 5 Then sinSollstunden = sinSollstunden + 5
End If
End If
End If
Next lngSpalte
End If
Next lngZeile
End With
'Nun Daten in Personalliste übertragen
With Worksheets("Personalliste")
'Sollstunden in Zelle C3 schreiben
.Range("C3") = sinSollstunden
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
Gruß
M.O.