Durchlaufgeschwindigkeit erhöhen

Option Explicit



'3. Möglichkeit: ein bestimmtes Projekt in einem bestimmten Zeitraum (DatumAnfang bis DatumEnde).

'1. Bedingung, dass es sich um das in der Einagbemaske angegebene Projekt handelt: Erfasst in dem Tabellenblatt "Leistungsmeldung" SpalteD

'2. Bedingung, dass die Leistung in dem in der Eingabemaske angegebenen Zeitraum (DatumAnfang bis DatumEnde)liegt.

Sub sbLeistungBestimmtesProjekt(ByVal DatumAnfang As Integer, ByVal DatumEnde As Integer, ByVal Projekt As String)



    Dim lshLeistung As Worksheet, lloRow As Long, lshSourceSpecProj As Worksheet

    

    'Dim larstrMA() As String, liIdxMA As Integer, lboExist As Boolean

    'Dim larMAData(), liIdxMAData As Integer

    'Dim lloRowNext As Long

    

    'Bildschirmaktualisierung ausschalten für Verbesserung der Geschwindigkeit des Codes

    Application.ScreenUpdating = False

    

    'bisherige Tabellen zur Auswertung entfernen

    TabellenEntfernen

    'alle ausgeblendeten Tabellenblätter einblenden

    Einblenden

    'mit der Set-Anweisung wird ein spezifisches Objekt (in dem Fall die jeweiligen Arbeitsblätter) zugewiesen.

    Set lshLeistung = Sheets("Leistungsmeldung")

    Set lshSourceSpecProj = Sheets("Auswertung Bestimmmtes Projekt")

 

        With lshLeistung

'Vorgehensweise im Vergleich zu den anderen 2 Möglichkeiten der Auswertung, es muss keine Miatarbeiterliste oder Projektliste erstellt werden.

'Mit einer For Next Schleife wird das Tabellenblatt "Leistungsmeldung" nach Treffern durchsucht, die die Kriterien Projekt und Zeitraum (DatumAnfang und DatumEnde)erfüllen

                    For lloRow = 2 To .Cells(.Rows.Count, 3).End(xlUp).Row

                        'wenn ein MA-Eintrag gefunden UND Monat in Tabelle der selbe ist wie ausgewählt UND auch das Jahr stimmt, dann...

                        If .Range("D" & lloRow).Value = Projekt And _

                           Format(.Range("A" & lloRow).Value, "dd.mm.yyyy") >= DatumAnfang And _

                           Format(.Range("A" & lloRow).Value, "dd.mm.yyyy") >= DatumEnde Then

'Vorgehensweise ab hier???

'In einer Array-Variable die Zeilennummer sammeln, in der der Eintrag gefunden wurde?

'Wie drücke ich das nun aus?











                       

 'Vorgehensweise ab hier ist ja dann wieder ähnlich wie bei "AuswertungMitarbeiter" und "AuswertungProjekte".

 'Das sollte ich dann irgendwie selber hinbekommen. Hoffe ich zumindest ;)

                       

                'wenn es in der zusätzlichen Arr-Variable keine Einträge gibt, dann...

                If UBound(larMAData, 2) = 0 And larMAData(0, 0) = "" Then

                        '...erscheint eine entsprechende Meldung, und...

                        MsgBox "Für " & monat & "/" & jahrzahl & " konnten keine Mitarbeitereinträge ermittelt werden."

                        '...das Makro wird beendet

                        Exit Sub

                    'gibt es doch Einträge in Arr-Var, dann...

                    Else

                        '...muss der letzte, leere Platz in Arr-Var wieder gelöscht werden

                        ReDim Preserve larMAData(1, UBound(larMAData, 2) - 1)

                End If





'wenn bis hier alles erfolgreich, dann haben wir genau das, und nur das, was du benötigst: nämlich Name des MA, und, noch wichtiger, nur all die Zeilennummern, in denen MA-Name, Monat + Jahr gleichzeitig in einer Zeile enthalten sind



                'mit For/Next werden all die gesammelten Einträge aus der zusätzlichen Arr-Var durchlaufen

                For liIdxMAData = 0 To UBound(larMAData, 2)

                        'wenn das gerade aktive Blatt z Bsp nicht "Mitarbeiter1" heißt, dann...

                        If ActiveSheet.Name > larMAData(0, liIdxMAData) Then

                            '...weiß der Code, es gibt das Blatt noch nicht und fügt es deiner Datei hinzu (es wird nur eine Kopie deiner Vorlage ans Ende der Datei positioniert) und...

                            lshSourceMA.Copy after:=Sheets(Sheets.Count)

                            '...Kopie der Vorlage erhält auch gleich den Namen des MA

                            ActiveSheet.Name = larMAData(0, liIdxMAData)

                            '...es werden die Stammdaten, wie aktuelles Datum, MA-Name, Jahr + Monat in den entsprechenden Zellen eingetragen

                            Range("G3").Value = Date

                            Range("B7").Value = larMAData(0, liIdxMAData)

                            Range("B8").Value = jahrzahl

                            Range("B9").Value = monat

                            'es wird die erste Zeile für die Datenzeilen festgelegt (in Bsp-Datei is es eigtl immer 12, aber wer weiß, ob das im Original auch immer so ist^^ :-)

                            lloRowNext = Cells(Rows.Count, 1).End(xlUp).Row + 1

                        End If

                    'im neuen Blatt, z Bsp "Mitarbeiter1", erhalten die Zellen in den Spalten A,B,C immer die Werte aus Blatt "Leistungsmeldung" aus den Zellen in den Spalten A,D,N (Zeile = immer die Zeile, die in der Arr-Var gesammelt wurde)

                    Range("A" & lloRowNext).Value = .Range("A" & larMAData(1, liIdxMAData)).Value

                    Range("B" & lloRowNext).Value = .Range("D" & larMAData(1, liIdxMAData)).Value

                    Range("C" & lloRowNext).Value = .Range("N" & larMAData(1, liIdxMAData)).Value

                        'die Anzahl in Spalte D soll numerisch mit 2 Kommastellen sein; a) Spalte D erhält Wert aus Spalte J, b) Format wird auf "0,00" eingestellt

                        With Range("D" & lloRowNext)

                            .Value = lshLeistung.Range("J" & larMAData(1, liIdxMAData)).Value

                            .NumberFormat = "0.00"

                        End With

                        'die jeweils verwendete Einheit in Spalte E soll rechtsbündig sein; a) Spalte E erhält Wert aus Spalte K, b) Eintrag wird rechtsbündig formatiert

                        With Range("E" & lloRowNext)

                            .Value = lshLeistung.Range("K" & larMAData(1, liIdxMAData)).Value

                            .HorizontalAlignment = xlRight

                        End With

                    'Spalte F erhält Wert aus Spalte L, Spalte G erhält Wert aus Spalte M

                    Range("F" & lloRowNext).Value = .Range("L" & larMAData(1, liIdxMAData)).Value

                    Range("G" & lloRowNext).Value = .Range("M" & larMAData(1, liIdxMAData)).Value

                    lloRowNext = lloRowNext + 1

                        If liIdxMAData  UBound(larMAData, 2) Then

                                'wenn in Arr-Var der nächste MA-Name anders ist als Name des aktuellen Blattes, dann...

                                If ActiveSheet.Name > larMAData(0, liIdxMAData + 1) Then

                                    '...weiß der Code: alle Einträge für z Bsp "Mitarbeiter1" wurden eingetragen, nun...

                                    With Range("G" & lloRowNext)

                                        '...fehlt noch in Spalte G die Summenformel, die mit der nächsten Codezeile hinzugefügt wird, und...

                                        .Formula = "=Sum(G12:G" & lloRowNext - 1 & ")"

                                        '...Ergebnis der Summe wird FETT dargestellt

                                        .Font.Bold = True

                                    End With

                                End If

                            Else

                                With Range("G" & lloRowNext)

                                    .Formula = "=Sum(G12:G" & lloRowNext - 1 & ")"

                                    .Font.Bold = True

                                End With

                        End If

                Next

                

        End With

        

    'alle eingeblendeten Tabellenblätter, die nicht benötigt werden, ausblenden.

    Ausblenden

    

    Application.ScreenUpdating = True

    

    Set lshLeistung = Nothing

    Set lshSourceMA = Nothing



End Sub