168 Aufrufe
Gefragt in Tabellenkalkulation von hakmatata Einsteiger (54 Punkte)

Liebe Leute,

ich habe es gestern schon den ganzen Tag versucht, aber nicht hinbekommen.

Ich habe eine Tabelle, wo in Spalte C die Namen von Mitarbeitern stehen.

In den jeweiligen Zeilen zum Mitarbeiter werden dann die An- und Abenwesenheiten gepflegt. Jedes Monat bzw. jeder Tag befindet sich als Spaltenüberschrift in weiteren Spalten rechts vom MA.

Hier ein Beispiel:

MA 1.1. 2.1 3.1 4.1 5.1 61.
Mayer FT 8 8 8 KR FT
Schuster FT UR UR UR UR FT
Mustermann FT 8 8 8 8 FT

Die Zahlen geben die Arbeitsstunden an, FT steht für Feiertag, KR für Krank, UR für Urlaub.

Ich benötige nun eine Formel oder wahrscheinlich viel eher ein Makro, welches mir pro MA die Anzahl von KR, UR und FT ausgibt.

Herausforderung: Als Makro Eingabe möchte ich das Monat eingeben und danach sollte sich dieses starten.

Also müsste das Makro zB. bei Eingabe "Jänner" wissen, dass es nur von 1.1. - 31.1. "sucht" und zählt.

Hat jemand evtl. soetwas schon mal benötigt und könnte mir da mit einem Code aushelfen?

DANKE

23 Antworten

0 Punkte
Beantwortet von hakmatata Einsteiger (54 Punkte)
Morgen M.O.!

Du entwickelst rascher als ich testen kann ;) DANKE!

In der abgespeckten , lediglich anonymisierten und um ein paar Tabellenblätter kleinere Version hat es auf Anhieb funktioniert, übernehm ich das Makro in die große Datei schmeißt es ihn hier mit folgender Meldung auf:

Meldung: Indes außerhalb des gültigen Bereichs

Debugger-Zeile: arrMitarbeiter(lngZaehler, 0) = .Cells(lngZeile, 2) 'Nummer des Mitarbeiters - Spalte B

Werte laut Debugger:

(lngZaehler, 0)=22
(lngZeile, 2)=46

Wenn ich nun dein Makro in die große übernehme und wieder abspecke bleibt der Fehler seltsamerweise - Ich frage mich an was das liegen kann, jedenfalls kannst du es nun auch nachvollziehen:

https://filehorst.de/d/cyywdsIH

Seltsam oder??
0 Punkte
Beantwortet von m-o Profi (12.6k Punkte)
ausgewählt von halfstone
 
Beste Antwort

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 wink)

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.

0 Punkte
Beantwortet von hakmatata Einsteiger (54 Punkte)
M.O. - Vielen Dank!

Es funktioniert alles wieder und noch besser !!!;)

Ich wünsche dir ein schönes Wochenende!

LG

54.4k Fragen

233k Antworten

6k Nutzer

...