AW: 1.Fehler entdeckt
15.09.2010 15:11:36
Dirk
Hallo Heinz,
hier ein Makro zum MA loeschen. Kopiere es in das Modul MainBase und starte es ueber einen Macrobutton.
Public Sub Mitarbeiter_Loeschen()
'Frage Letzten Arbeitstag ab und loesche alle Zeilen in allen Monatstabellen nach diesem Datum
Dim MyName As String, Letzter As Date, Ultimo As Boolean, MyMonth As String, MyMonthArr(12), _
UserInput As String
Dim i As Long, k As Long, Myfind As Range, MyCell As Object, MonatDays As Long, MyRange As _
Range, StartCol As Long
'Monatsarray belegen
MyMonthArr(1) = "Januar"
MyMonthArr(2) = "Febuar"
MyMonthArr(3) = "Maerz"
MyMonthArr(4) = "April"
MyMonthArr(5) = "Mai"
MyMonthArr(6) = "Juni"
MyMonthArr(7) = "Juli"
MyMonthArr(8) = "August"
MyMonthArr(9) = "September"
MyMonthArr(10) = "Oktober"
MyMonthArr(11) = "November"
MyMonthArr(12) = "Dezember"
'Startspalte festlegen,in welcher sich der 1. des Monats befindet
StartCol = 3 'Spalte C
Wiederholen:
MyName = InputBox("Bitte geben Sie den Namen des zu loeschenden Mitarbeiters ein:", " _
Mitarbeiter loeschen")
If MyName "" Then
Letzter = InputBox("Bitte geben Sie das Datum des Letzten Arbeitstag des Mitarbeiters ein:", _
" Mitarbeiter " & MyName & " loeschen")
If IsDate(Letzter) Then
UserInput = MsgBox("Soll der Mitarbeiter '" & MyName & "' ab " & Letzter + 1 & " _
aus dem Schichtplan entfernt werden?", 33, "Loeschabfrage")
If UserInput = vbOK Then
GoTo MA_Loeschen
Else
MsgBox "Loeschen abgebrochen"
Exit Sub
End If
Else
MsgBox "Loeschen abgebrochen"
Exit Sub
End If
Else
MsgBox "Loeschen abgebrochen"
Exit Sub
End If
MA_Loeschen:
Application.EnableEvents = False
MyMonth = MyMonthArr(Month(Letzter))
MonatDays = Day(DateSerial(Year(Letzter), Month(Letzter) + 1, 1) - 1)
If MonatDays = Day(Letzter) Then
'Kuendigung zum Monatsletzten, Schichten ab naechsten monat loeschen
i = Month(Letzter) + 1
Ultimo = True
Else
i = Month(Letzter)
End If
For i = i To 12
ThisWorkbook.Sheets(MyMonthArr(i)).Select
Set MyRange = Range("A3:A154")
With MyRange
Set Myfind = .Find(what:="*" & MyName & "*")
If Not Myfind Is Nothing Then
If Ultimo = True Then
Range(Myfind.Address).EntireRow.Delete
Else
For k = Day(Letzter) + StartCol To MonatDays + StartCol
Cells(Myfind.Row, k).Value = ""
Next k
End If
Else
UserInput = MsgBox("Mitarbeiter konnte nicht gefunden werden!" & vbCrLf & _
"Bitte Schreibweise pruefen: " & MyName, vbRetryCancel & vbCritical, " _
Fehler beim Mitarbeiternamen")
If UserInput = vbRetry Then
GoTo Wiederholen
Else
'Benutzerabbruch
GoTo Abbruch
End If
End If
End With
Next i
MsgBox "Der Mitarbeiter wurde aus den verbleibenden Schichtplaenen geloescht"
Abbruch:
Application.EnableEvents = True
End Sub
Man koennte auch noch eine Liste der Mitarbeiter erstellen, aus der ausgewaehlt wird, aber dafuer muesste man dann eine userform kreieren.
Lass' hoeren, ob so ok.
Gruss
Dirk aus Dubai