AW: Uplaner Hilfe Dirk aus Dubai
09.01.2012 11:50:46
Dirk
Hallo Burkhard,
ersetze mal das Makro im Tabellenblatt Urlaubseintraege durch dieses:
Sub Urlaub_eintragen(Target As Range)
'dieses Makro traegt den Eingetragenen Urlaub in das Blatt '1. Quartal 2012' ein
Dim i As Long
Dim MaName As String
Dim FirstD As Date
Dim LastD As Date
Dim AnzTage As Long
Dim UTyp As String
'Mitarbeiter Name lesen
MaName = Cells(Target.Row, 3).Value
'ersten Urlaubstag lesen
FirstD = Cells(Target.Row, 4).Value
'letzten urlaubstag lesen
LastD = Cells(Target.Row, 5).Value
'Anzahl Kalendertage bestimmen
AnzTage = (LastD - FirstD) + 1
'Abwesenheitstyp auslesen
UTyp = Cells(Target.Row, 8).Value
'MsgBox "Anzahl Kalendertage: " & AnzTage & vbCrLf & _
"Anzahl Urlaubstage: " & Target.Offset(0, 2).Value
'Erste Zelle im Quartalsblatt bestimmen
Set targetsh = ThisWorkbook.Sheets("1. Quartal 2012")
With targetsh.Columns(3).Cells
Set myfind = .Find(what:=MaName, LookIn:=xlValues, lookat:=xlWhole)
If Not myfind Is Nothing Then
'MaName wurde gefunden
targetRow = myfind.Row
'Ersten Tag des Urlaubs Zeile 4 in Blatt finden
For i = 5 To 95
Debug.Print targetsh.Cells(4, i).Value
If targetsh.Cells(4, i).Value = FirstD Then
'Datum gefunden
'Schleife zum Eintragen der Urlaubstage
Application.EnableEvents = False
For j = i To i + AnzTage - 1
'pruefen ob Wochentag oder Wochenende,
'falls auch Fehltage an Wochenenden angezeigt werden sollen, dann _
auskommentieren
Debug.Print targetsh.Cells(7, i).Value
If targetsh.Cells(7, j).Value "" Then
targetsh.Cells(targetRow, j).Value = UCase(UTyp)
End If
Next j
Application.EnableEvents = True
Exit For
End If
Next i
If i > 95 Then
'Datum nicht gefunden, Hinweis
MsgBox "Das Anfangsdatum des Urlaubs konnte im Blatt '" & targetsh.Name & "' _
nicht gefunden werden." & vbCrLf & _
"Bitte Tabellenblatt und Urlaubsdaten pruefen!", 48, "Kein Urlaub eingetragen!"
Exit Sub
End If
Else
'MaName nicht gefunden, hinweiss
MsgBox "Der Mitabrbeiter " & MaName & " konnte im Blatt '" & targetsh.Name & " nicht _
gefunden werden!" & vbCrLf & _
"Bitte Blatt '" & targetsh.Name & "' pruefen!", 48, "Urlaub nicht eingetragen!" _
Exit Sub
End If
End With
End Sub
Lass' hoeren, ob ok.
Gruss
Dirk aus Dubai