Feiertage und Wochenden Überspringen

[Hirmthurs]

Guten Tag zusammen,

ich hätte da mal eine Frage. Zwar geht es darum das ich gerne mit einem VBA Code Feiertage und Wochenenden überspringen möchte

   

So sieht es zur Zeit aus möchte aber das es so Aussieht


   


Vielleicht kann mir ja jemand von euch Helfen. Denn Urlaub trage ich über eine UserForm ein die Formel:



Private Sub ButtonSpeichern_Click()
    Dim sDatum As Variant
    Dim eDatum As Variant
    Dim Kollege As Range
    Dim Wks
    Dim i As Long
    Dim neueZeile As Long
   
    If ComboBoxVorundNachname = "" Or TextBoxAbwesendvon.Value = "" Or TextBoxAbwesendbis = "" Or ComboBoxAbwesend.Value = "" Then
        MsgBox "Bitte füllen sie alle Felder aus!"
        Exit Sub
    End If
   
    If ComboBoxVorundNachname.List(ComboBoxVorundNachname.ListIndex, 1) = "Schicht A" Then Set Wks = Tabelle2
    If ComboBoxVorundNachname.List(ComboBoxVorundNachname.ListIndex, 1) = "Schicht B" Then Set Wks = Tabelle4
    If ComboBoxVorundNachname.List(ComboBoxVorundNachname.ListIndex, 1) = "Schicht C" Then Set Wks = Tabelle6
    With Wks
        Set Kollege = .Columns(3).Find(ComboBoxVorundNachname.List(ComboBoxVorundNachname.ListIndex, 0), LookIn:=xlValues)
        If IsNumeric(TextBoxAbwesendvon) Then
            sDatum = Application.Match(CLng(CDate(TextBoxAbwesendvon)), .Rows(6), 0)
        Else
            MsgBox "Bitte Datum eintragen"
            TextBoxAbwesendvon = ""
            TextBoxAbwesendvon.SetFocus
            Exit Sub
        End If
        If IsNumeric(TextBoxAbwesendbis) Then
            eDatum = Application.Match(CLng(CDate(TextBoxAbwesendbis)), .Rows(6), 0)
        Else
            MsgBox "Bitte Datum eintragen"
            TextBoxAbwesendbis = ""
            TextBoxAbwesendbis.SetFocus
            Exit Sub
        End If
        If Not Kollege Is Nothing Then
            For i = sDatum To eDatum
                .Cells(Kollege.Row, i) = ComboBoxAbwesend
            Next i
 
        End If
    End With
    Unload Me
End Sub

In einer Weitere Tabelle (Tabelle3) sind die Feiertage eingetragen:

   

Würde mich um eine Lösung freuen :)

[BoskoBiati]

Hi,

vielleicht siehst Du Dir mal Deinen Beitrag an, sollte man auch machen, bevor man ihn abschickt!

[Hirmthurs]

ja ich weiß habe zu schnell abgeschickt :/ zu spät gesehen. Wollte es auch gleich wieder löschen. Aber finde leider kein Button zum Beitrag löschen

[BoskoBiati]

Hallo,

Du kannst ihn doch bearbeiten, z.B. die Dateien nachträglich einfügen.

[Hirmthurs]

Danke ist Passiert sorry nochmal 

[BoskoBiati]

Hi,

ich sehe keine Dateien, nur Bildchen, mit denen man nichts anfangen kann.

[Gast 123]

Hallo

wenn ich deinen Code richtig verstanden habe muss nur der Teil geändert werden, wo die Eintragung erfolgt.

Samstag Sonntag ist leicht zu überspringen, sofern der Code es als Text auslesen kann. Bei Formel evtl. schwierig.
Sofern die Wochentage keine Innenfarbe haben kann man auch die Innenfarbe zum Überspringen auswerten.
Ob es allerdings bei bedingter Formatierung klappt weiss ich nicht genau??

Im Zweifelsfalle muss man da noch eine For Next Schleife für die Feiertage einbauen. Einfach mal experimentieren.

mfg Gast 123

Code:

        If Not Kollege Is Nothing Then
            For i = sDatum To eDatum
              If .Cells(7, i).Text = "Sa" Or _
                 .Cells(7, i).Text = "So" Then
              ElseIf .Cells(7, i).Interior.ColorIndex <> xlNone Then
              Else
                 .Cells(Kollege.Row, i) = ComboBoxAbwesend
            Next i
        End If

[Hirmthurs]

Danke aber leider klappt dies nicht :/

[Egon12]

Hallo,

ich habe mal die alte Demodatei von dir als Vorlage genommen und die Ausschlusskriterien Sa/So/Feiertage eingebaut.

Code:

Private Sub ButtonSpeichern_Click()
    Dim sDatum As Variant
    Dim eDatum As Variant
    Dim Kollege As Range
    Dim Wks
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim neueZeile As Long
    Dim Feiertage()
    With Tabelle3   ' Feiertage in ein Array schreiben
        For i = 5 To 21
            If .Cells(i, 3) <> "" Then
                k = k + 1
                ReDim Preserve Feiertage(1 To k)
                Feiertage(k) = .Cells(i, 3)
            End If
        Next i
        k = 0
    End With
    If ComboBoxVorundNachname = "" Or TextBoxAbwesendvon.Value = "" Or TextBoxAbwesendbis = "" Or ComboBoxAbwesend.Value = "" Then
        MsgBox "Bitte füllen sie alle Felder aus!"
        Exit Sub
    End If
   
    If ComboBoxVorundNachname.List(ComboBoxVorundNachname.ListIndex, 1) = "Schicht A" Then Set Wks = Tabelle2
    If ComboBoxVorundNachname.List(ComboBoxVorundNachname.ListIndex, 1) = "Schicht B" Then Set Wks = Tabelle4
    With Wks
        Set Kollege = .Columns(3).Find(ComboBoxVorundNachname.List(ComboBoxVorundNachname.ListIndex, 0), LookIn:=xlValues)
        If IsNumeric(TextBoxAbwesendvon) Then
            sDatum = Application.Match(CLng(CDate(TextBoxAbwesendvon)), .Rows(6), 0)
        Else
            MsgBox "Bitte Datum eintragen"
            TextBoxAbwesendvon = ""
            TextBoxAbwesendvon.SetFocus
            Exit Sub
        End If
        If IsNumeric(TextBoxAbwesendbis) Then
            eDatum = Application.Match(CLng(CDate(TextBoxAbwesendbis)), .Rows(6), 0)
        Else
            MsgBox "Bitte Datum eintragen"
            TextBoxAbwesendbis = ""
            TextBoxAbwesendbis.SetFocus
            Exit Sub
        End If
        If Not Kollege Is Nothing Then
            For i = sDatum To eDatum
                If WorksheetFunction.Weekday(.Cells(6, i), 2) < 6 Then  ' Auschluß Sa und So
                    For j = 1 To UBound(Feiertage)  ' Abfrage ob Datum einem Feiertag entspricht
                        If Feiertage(j) = .Cells(6, i) Then k = k + 1
                    Next j
                    If k = 0 Then .Cells(Kollege.Row, i) = ComboBoxAbwesend
                    k = 0
                End If
            Next i
        End If
    End With
    With Tabelle6
        neueZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(neueZeile, 2).Value = ComboBoxVorundNachname.Value
        .Cells(neueZeile, 4).Value = TextBoxAbwesendvon.Value
        .Cells(neueZeile, 5).Value = TextBoxAbwesendbis.Value
        .Cells(neueZeile, 6).Value = ComboBoxAbwesend.Value
    End With
    Unload Me
End Sub

Eigentlich könnte man das einfacher lösen. Aber bei dem Aufbau sind die Möglichkeiten eingeschränkt.

  Urlaubsplaner(2).xlsm (Größe: 1,72 MB / Downloads: 4)

Gruß Uwe

[Hirmthurs]

Hey,

ich danke dir es klappt :) vielen dank dir nochmal