Urlaubsplaner

[Hobbit]

Moin,
ich habe eine Urlaubsdatei, die nicht so Funktioniert wie sie soll.
Im 1. Halbjahr wenn ich über die Userform die Daten eingebe, klappt es.

Wenn ich aus dem 1. Halbjahr ins 2. Halbjahr, z.B. vom 26.06.2026 - 07.07.2026 muss, dann trägt er es an der falschen stelle ein.
Ich habe schon probiert die Daten im VBA zu ändern, aber ich komme einfach nicht weiter.

Ich habe die Datei mal angehängt.
Könnt ihr da bitte helfen?
Wenn noch fragen sind, gerne melden.

Vielen dank für die Mühen.

Mfg Jens

[Egon12]

Hallo Jens,

dir sollten schon klar sein, dass Feiertage keine Urlaubstage sind.
Wo hast du denn dieses Userform her. 

Ich bau es dir mal um. Es wird etwas dauern, da es keine Sache von ein paar Minuten ist.
Es wäre auch sinnvoll einen vernüftigen Feiertagskalender einzubauen, statt der Einträge für die bedingte Formatierung gaaanz weit unten.

Gruß Uwe

[Hobbit]

Moin,
Wir benutzen diese Datei schon Jahre, aber ich musste leider wegen dem Filter 2 Spalten einfügen und jetzt klappt es nicht mehr so wie es soll.
So wie er jetzt aufgebaut ist, wäre schon gut, weil ich nach den Einzelnen Abteilungen Filtern muss.
Wenn du etwas Basteln möchtest, nehme ich es sehr gerne.
Muss aber nicht am Wochende sein.
Ich kann es sowieso Montag erst Testen.
Vielen Dank für die Mühen. 
Ich wünsche dir ein schönes Wochenende. 
Mfg Jens

[Egon12]

Hallo Jens,
 
so lang braucht es nun auch wieder nicht.
 
Vielleicht solltet ihr euch mal über folgendes Gedanken machen:
 
- Alles Daten wie Mitarbeiter Urlaub / krank etc. Beginn Ende in einer Tabelle Eintrag für Eintrag erfassen. Dies kann auch fortlaufend für X Jahre sein.
 
- Halbjahresplanung zwecks Ausdrucks per Dropdown auswählen. In den Zellen via Formel das dazugehörige Kürzel bzw. die bedingte Formatierung (schlank gehalten) füllen/gestalten.
 
-fertig ist eine flexible und nach Bedarf erweiterbare über langen Zeitraum nutzbare Lösung.
 
Das was du hochgeladen hast ist es so nicht.
 
Anbei meine Änderungen im Userform.
Du wirst feststellen, dass die Sache drastisch schneller ist als das einzelne Geleier durch jede Zelle.

Ach ja, die Feiertage aus Tabelle3 (Bitte lesen) werden nun auch nicht mehr mit einem "U" versehen. 
 
 
Gruß Uwe

---

ich hab mal noch die Fehlerbehandlung erweitert.

Tausche diesen Teil aus:

Code:

Private Sub CommandButton1_Click()
    Dim iSt&, iE&, dateS As Variant, dateE As Variant, Mitarb As Variant, tmp$, i&, Ende1&, Anfang2&
    Mitarb = Application.Match(ComboBox1, Tabelle1.Columns(3), 0)
    If IsError(Mitarb) Then MsgBox "Es wurde kein Mitarbeiter augewählt": Exit Sub
    If IsDate(TextBox1) And IsDate(TextBox2) Then
        If Year(TextBox1) = Tabelle1.Cells(1, 3) And Year(TextBox2) = Tabelle1.Cells(1, 3) Then
            If TextBox1 > texbox2 Then Exit Sub
            If Month(CDate(TextBox1)) < 7 And Month(CDate(TextBox2)) < 7 Then
                With Tabelle1
                    dateS = Application.Match(CLng(CDate(TextBox1)), .Rows(3), 0)
                    dateE = Application.Match(CLng(CDate(TextBox2)), .Rows(3), 0)
                    For i = dateS To dateE
                        If WorksheetFunction.NetworkDays_Intl(.Cells(3, i), .Cells(3, i), 1, Tabelle3.Range("B4:B17")) Then
                            tmp = tmp & Replace(.Cells(Mitarb, i).Address, "$", "") & ","
                        End If
                    Next i
                    .Range(Left(tmp, Len(tmp) - 1)) = "U"
                End With
            ElseIf Month(CDate(TextBox1)) < 7 And Month(CDate(TextBox2)) > 6 Then
                With Tabelle1
                    dateS = Application.Match(CLng(CDate(TextBox1)), .Rows(3), 0)
                    Ende1 = Application.Match(CLng(DateSerial(.Cells(1, 3), 6, 30)), .Rows(3), 0)
                    For i = dateS To Ende1
                        If WorksheetFunction.NetworkDays_Intl(.Cells(3, i), .Cells(3, i), 1, Tabelle3.Range("B4:B17")) Then
                            tmp = tmp & Replace(.Cells(Mitarb, i).Address, "$", "") & ","
                        End If
                    Next i
                    .Range(Left(tmp, Len(tmp) - 1)) = "U"
                    tmp = ""
                End With
                With Tabelle2
                    Anfang2 = Application.Match(CLng(DateSerial(Tabelle2.Cells(1, 3), 7, 1)), .Rows(3), 0)
                    dateE = Application.Match(CLng(CDate(TextBox2)), Tabelle2.Rows(3), 0)
                    For i = Anfang2 To dateE
                        If WorksheetFunction.NetworkDays_Intl(.Cells(3, i), .Cells(3, i), 1, Tabelle3.Range("B4:B17")) Then
                            tmp = tmp & Replace(.Cells(Mitarb, i).Address, "$", "") & ","
                        End If
                    Next i
                    .Range(Left(tmp, Len(tmp) - 1)) = "U"
                End With
            Else
                With Tabelle2
                    dateS = Application.Match(CLng(CDate(TextBox1)), .Rows(3), 0)
                    dateE = Application.Match(CLng(CDate(TextBox2)), .Rows(3), 0)
                    Mitarb = Application.Match(ComboBox1, .Columns(3), 0)
                    For i = dateS To dateE
                        If WorksheetFunction.NetworkDays_Intl(.Cells(3, i), .Cells(3, i), 1, Tabelle3.Range("B4:B17")) Then
                            tmp = tmp & Replace(.Cells(Mitarb, i).Address, "$", "") & ","
                        End If
                    Next i
                    .Range(Left(tmp, Len(tmp) - 1)) = "U"
                End With
            End If
        Else
            MsgBox "Es kann nur für das Kalenderjahr " & Tabelle1.Cells(1, 3) & " Urlaub eingetragen werden!", vbExclamation
        End If
    End If
End Sub

Zur Ergänzung wegen Schaltjahr: in Zelle "GC3" Tabelle "1. Halbjahr" die Formel =WENN(DATUM(C1;6;30)=GB3+1;GB3+1;"")
Änder Desweiteren den Spinbutton statt .Cells(1, 1) dann .Cells(1, 3) zu.

Gruß Uwe

[Egon12]

Hallo Jens,

ich sehe gerade, dass du O2013 angegeben hast. Ist dies tatsächlich noch so?
Einen Tippfehler hatte ich auch noch drin. Ändere texbox2 -->TextBox2 in Zeile7

Gruß Uwe

[Klaus-Dieter]

Hallo,

im Kern stammt diese Datei von mir. Erstellt hatte ich die zu den Zeiten, als Excel noch 256 Spalten hatte, deshalb die (unsinnige) Aufteilung in zwei Halbjahre. Seit Excel 2007 habe ich so etwas nicht mehr gemacht. Unabhängig davon würde ich heute vieles anders lösen.
Da aus den Makros mein Name entfernt wurde, habe ich wenig Neigung hier zu helfen.

[Egon12]

@ Klaus-Dieter,
 
du musst dich da nicht rechtfertigen - es war eben damals so.
 
Ich habe heute früh gesehen, dass der TO wohl Office 2013 nutzt. Da bleibt eh nur der Weg via VBA. Den hat er jetzt entsprechend angepasst und beschleunigt. 
Ich weiß nicht, ob es da schon PQ gab? Wenn ja, wäre dies noch ein Weg in einer Timline als Zwischenschritt auszugeben.
 
Gruß Uwe

[Hobbit]

Moin Klaus Dieter,

Ich hatte sie von meinen ehemaligen Kollegen so bekommen.

Ich habe dort nichts entfernt.

Verstehe dein Unmut.

Ich wünsche dir einen schönen Feiertag und ein schönes Wochenende.

MFG Jens

[Klaus-Dieter]

@ Uwe, 

eine Rechtfertigung sollte das auch nicht sein, nur ein Hinweis darauf, warum ich hier anders gehandelt habe, als ich es sonst empfehle. Auch ein (versteckter) Hinweis darauf, wie man das Problem, das ich nicht nachvollziehen konnte, beheben könnte. Dazu müsste man dann aber in der Lage sein, die Makros (Jugendsünden meinerseits) anzupassen. (Die würde ich neu schreiben).

[Hobbit]

Hallo Jens,
 
so lang braucht es nun auch wieder nicht.
 
Vielleicht solltet ihr euch mal über folgendes Gedanken machen:
 
- Alles Daten wie Mitarbeiter Urlaub / krank etc. Beginn Ende in einer Tabelle Eintrag für Eintrag erfassen. Dies kann auch fortlaufend für X Jahre sein.
 
- Halbjahresplanung zwecks Ausdrucks per Dropdown auswählen. In den Zellen via Formel das dazugehörige Kürzel bzw. die bedingte Formatierung (schlank gehalten) füllen/gestalten.
 
-fertig ist eine flexible und nach Bedarf erweiterbare über langen Zeitraum nutzbare Lösung.
 
Das was du hochgeladen hast ist es so nicht.
 
Anbei meine Änderungen im Userform.
Du wirst feststellen, dass die Sache drastisch schneller ist als das einzelne Geleier durch jede Zelle.

Ach ja, die Feiertage aus Tabelle3 (Bitte lesen) werden nun auch nicht mehr mit einem "U" versehen. 
 
 
Gruß Uwe

---

ich hab mal noch die Fehlerbehandlung erweitert.

Tausche diesen Teil aus:

Code:

Private Sub CommandButton1_Click()
    Dim iSt&, iE&, dateS As Variant, dateE As Variant, Mitarb As Variant, tmp$, i&, Ende1&, Anfang2&
    Mitarb = Application.Match(ComboBox1, Tabelle1.Columns(3), 0)
    If IsError(Mitarb) Then MsgBox "Es wurde kein Mitarbeiter augewählt": Exit Sub
    If IsDate(TextBox1) And IsDate(TextBox2) Then
        If Year(TextBox1) = Tabelle1.Cells(1, 3) And Year(TextBox2) = Tabelle1.Cells(1, 3) Then
            If TextBox1 > texbox2 Then Exit Sub
            If Month(CDate(TextBox1)) < 7 And Month(CDate(TextBox2)) < 7 Then
                With Tabelle1
                    dateS = Application.Match(CLng(CDate(TextBox1)), .Rows(3), 0)
                    dateE = Application.Match(CLng(CDate(TextBox2)), .Rows(3), 0)
                    For i = dateS To dateE
                        If WorksheetFunction.NetworkDays_Intl(.Cells(3, i), .Cells(3, i), 1, Tabelle3.Range("B4:B17")) Then
                            tmp = tmp & Replace(.Cells(Mitarb, i).Address, "$", "") & ","
                        End If
                    Next i
                    .Range(Left(tmp, Len(tmp) - 1)) = "U"
                End With
            ElseIf Month(CDate(TextBox1)) < 7 And Month(CDate(TextBox2)) > 6 Then
                With Tabelle1
                    dateS = Application.Match(CLng(CDate(TextBox1)), .Rows(3), 0)
                    Ende1 = Application.Match(CLng(DateSerial(.Cells(1, 3), 6, 30)), .Rows(3), 0)
                    For i = dateS To Ende1
                        If WorksheetFunction.NetworkDays_Intl(.Cells(3, i), .Cells(3, i), 1, Tabelle3.Range("B4:B17")) Then
                            tmp = tmp & Replace(.Cells(Mitarb, i).Address, "$", "") & ","
                        End If
                    Next i
                    .Range(Left(tmp, Len(tmp) - 1)) = "U"
                    tmp = ""
                End With
                With Tabelle2
                    Anfang2 = Application.Match(CLng(DateSerial(Tabelle2.Cells(1, 3), 7, 1)), .Rows(3), 0)
                    dateE = Application.Match(CLng(CDate(TextBox2)), Tabelle2.Rows(3), 0)
                    For i = Anfang2 To dateE
                        If WorksheetFunction.NetworkDays_Intl(.Cells(3, i), .Cells(3, i), 1, Tabelle3.Range("B4:B17")) Then
                            tmp = tmp & Replace(.Cells(Mitarb, i).Address, "$", "") & ","
                        End If
                    Next i
                    .Range(Left(tmp, Len(tmp) - 1)) = "U"
                End With
            Else
                With Tabelle2
                    dateS = Application.Match(CLng(CDate(TextBox1)), .Rows(3), 0)
                    dateE = Application.Match(CLng(CDate(TextBox2)), .Rows(3), 0)
                    Mitarb = Application.Match(ComboBox1, .Columns(3), 0)
                    For i = dateS To dateE
                        If WorksheetFunction.NetworkDays_Intl(.Cells(3, i), .Cells(3, i), 1, Tabelle3.Range("B4:B17")) Then
                            tmp = tmp & Replace(.Cells(Mitarb, i).Address, "$", "") & ","
                        End If
                    Next i
                    .Range(Left(tmp, Len(tmp) - 1)) = "U"
                End With
            End If
        Else
            MsgBox "Es kann nur für das Kalenderjahr " & Tabelle1.Cells(1, 3) & " Urlaub eingetragen werden!", vbExclamation
        End If
    End If
End Sub

Zur Ergänzung wegen Schaltjahr: in Zelle "GC3" Tabelle "1. Halbjahr" die Formel =WENN(DATUM(C1;6;30)=GB3+1;GB3+1;"")
Änder Desweiteren den Spinbutton statt .Cells(1, 1) dann .Cells(1, 3) zu.

Gruß Uwe

Moin,

ich habe es gerade mit Office 2019 getestet, aber es wird nichts eingetragen wenn ich über die Userform etwas eintrage.
Oder ist es tatsächlich nur für 2013 gedacht?

Vielen Dank für die Mühen.

MFG Jens