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
|