Hallo an alle,

ich arbeite aktuell an einem Projekt, bei dem man die Arbeitszeit erfassen kann und bestimmte Dinge eben dann automatisch passieren, wie z.B. Berechnung der gesamten Arbeitszeit. Mein Problem ist aktuell die Mitarbeiterliste. Es gibt ein Worksheet namens Mitarbeiter, in der alle Mitarbeiter eingetragen sind.

Beim löschen, hinzufügen, editieren soll für jeden Eintrag auf dem Worksheet Gesamt eine Tabelle mit den Mitarbeiternamen befüllt werden. Wurde ein Mitarbeiter gelöscht, müssen dementsprechend auch seine Stunden zurückgesetzt werden. Je nachdem wie viele Mitarbeiter aktuell beschäftigt sind, sollen die restlichen Arbeitsblätter ausgeblendet werden. Die übriggebliebenen Worksheets sollen jeweils den Namen vom passendem Mitarbeiter bekommen. 

Meine Methode ist aktuell, am Anfang sich eine Liste von den Miarbeitern zu speichern in einem Array. Sobald das Worksheet_Change Event getriggered wird beim AB Mitarbeiter soll dann ein Vergleich der beiden Listen stattfinden und dementsprechend dann gelöscht, editiert oder hinzugefügt wird.

Hier mein Mitarbeiter Worksheet:

Option Explicit
Const iMaxMitarbeiter = 16

Private Sub Worksheet_Activate()
    ReDim Employees_Old(Worksheets("Mitarbeiter").Cells(Worksheets("Mitarbeiter").Rows.Count, "A").End(xlUp).Row)
End Sub

'
' Neue Version
'
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Row As Integer
    Dim WSID As Integer
    Dim i As Integer
    Dim StartTimeRow As Integer
    Dim EndTimeRow As Integer
    Dim CountEntriesInEmployees_New As Integer
    Dim ws As Worksheet
    Dim Cell As Range
    ReDim Employees_New(Worksheets("Mitarbeiter").Cells(Worksheets("Mitarbeiter").Rows.Count, "A").End(xlUp).Row)

    Employees_New = mEmployees.GetEmployees()
    NumberOfEmployees_New = mEmployees.CountEmployees()
    CountEntriesInEmployees_New = CInt(UBound(Employees_New)) - 1
    Row = 9
    WSID = 1
    
    With Worksheets("Gesamt")
        .Rows("9:48").EntireRow.Hidden = False
        
        For Each ws In ActiveWorkbook.Worksheets
            If Not ws.Name = "Gesamt" And Not ws.Name = "Mitarbeiter" And Not ws.Name = "Schichtzeiten" Then
                ws.Visible = xlSheetHidden
            End If
        Next ws
        
        For i = 0 To CountEntriesInEmployees_New
            Row = Row + 4 * i
            StartTimeRow = Row + 1
            EndTimeRow = Row + 2
            
            MsgBox i
            
            If i > CInt(UBound(Employees_Old)) Then
                If Platzhalter(i, Employees_New, Row, WSID) Then
                    MsgBox "War erfolgreich"
                Else
                    MsgBox "War nicht erfolgreich"
                End If
            End If
            
            If Not Employees_Old(i) = Employees_New(i) Then
                If Employees_Old(i) <> "" And Employees_New(i) = "" Then
                    For Each Cell In .Range("B" & StartTimeRow & ":AF" & StartTimeRow)
                        Cell.Value = "00:00:00"
                    Next Cell
                    
                    For Each Cell In .Range("B" & EndTimeRow & ":AF" & EndTimeRow)
                        Cell.Value = "00:00:00"
                    Next Cell
                    
                    CountEntriesInEmployees_New = CountEntriesInEmployees_New + 1
                End If
                
                If Platzhalter(i, Employees_New, Row, WSID) Then
                    MsgBox "War erfolgreich2"
                Else
                    MsgBox "War nicht erfolgreich2"
                End If
            End If
            
            WSID = WSID + 1
        Next i
        
        .Rows(NumberOfEmployees_Old * 4 + 9 & ":48").EntireRow.Hidden = True
    End With
    
    ReDim Employees_Old(UBound(Employees_New))
        
    For i = 0 To CInt(UBound(Employees_New))
        Employees_Old(i) = Employees_New(i)
    Next i
End Sub

Die Funktion 'Platzhalter':

Private Function Platzhalter(i As Integer, Employees As Variant, Row As Integer, WSID As Integer) As Boolean
    Dim Pattern As String
    Dim RegEx As New RegExp
    
    Pattern = "\\\/\?\*\[\]"
    
    With RegEx
        .Global = True
        .IgnoreCase = False
        .Pattern = Pattern
    End With
    
    If Len(Employees(i)) > 31 Or RegEx.Test(Employees(i)) Then
        Platzhalter = False
        Exit Function
    End If
    
    With Worksheets("Gesamt")
        .Range("A" & Row).Value = Employees(i)
        If Worksheets(WSID).Name = "Gesamt" And Worksheets(WSID).Name = "Schichtzeiten" And Worksheets(WSID).Name = "Mitarbeiter" Then
            If Worksheets(WSID + 1).Name = "Mitarbeiter" Then
               WSID = WSID + 2
            Else
               WSID = WSID + 1
            End If
        End If
        
        Worksheets(WSID).Name = Employees_New(i)
        Worksheets(WSID).Visible = xlSheetVisible
    End With
    
    Platzhalter = True
End Function

Das Modul mEmployees:

Option Explicit
Public Employees_Old() As Variant
Public NumberOfEmployees_Old As Integer
Public Employees_New() As Variant
Public NumberOfEmployees_New As Integer

Public Function GetEmployees() As Variant
    Dim LastRow As Integer
    Dim Employees() As Variant
    Dim i As Integer

    i = 2

    With Worksheets("Mitarbeiter")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        ReDim Employees(LastRow - 2) As Variant

        While i <= LastRow
'            If .Cells(i, "A").Value <> "" Then
'            End If

            Employees(i - 2) = .Cells(i, "A").Value
            i = i + 1
        Wend
    End With

    GetEmployees = Employees
End Function

Public Function CountEmployees() As Integer
    Dim LastRow As Integer
    Dim Number As Integer
    Dim i As Integer

    Number = 0
    i = 2
    
    With Worksheets("Mitarbeiter")
        'Ermittlung der letzten Zelle mit einem Wert
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        While i <= LastRow
            'Sollte die Zelle einen Wert enthalten, addiere zu der Anzahl der bereits vorhandenen Mitarbeiter + 1
            If Not .Cells(i, "A").Value = "" Then
                Number = Number + 1
            End If

            i = i + 1
        Wend
    End With

    CountEmployees = Number
End Function

Bin dankbar für jeden Tipp :)

Liebe Grüße