Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Feiertage und Wochenden Überspringen
#1
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 :)
Antworten Top
#2
Hi,

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

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Antworten Top
#3
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
Antworten Top
#4
Hallo,

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

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Antworten Top
#5
Danke ist Passiert sorry nochmal  Confused
Antworten Top
#6
Hi,

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

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Antworten Top
#7
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
Antworten Top
#8
Danke aber leider klappt dies nicht :/
Antworten Top
#9
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.

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

Gruß Uwe
Antworten Top
#10
Hey,

ich danke dir es klappt :) vielen dank dir nochmal
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste