Office: Schleife?

Smeargol · 11. September 2016

Moin, moin.

Also ich habe mich jetzt schon durch verschiedenste Scripte durchgewurschtelt und habe sie auch irgendwie zu laufen gebracht *stolz*

Jetzt brauche ich aber ernsthaft Hilfe, da ich nicht glaube, dass ich sonst weiterkomme...

Vereinfachte Darstellung:

- Mappe mit 15 Tabellen (12 Monate und anderes)
- Hier sollen nur die 12 Tabellen mit den Monaten (von den 15 Tabellen) mit jeweils 31 Zeilen (in Spalte A steht ein Datum), einbezogen werden
- Userform mit ListBox (Auswahl 1 - 5) und Textbox (Datumeingabe) und Button, öffnet bei klick auf Zelle in Spalte J

Bis hier funktioniert´s-------------------

Dann aber.....

- Der Eintrag im UserformTextfeld (Datum) soll nur einbezogen werden, wenn Bedingung 1 oder 2 (Auswahl 1 oder Auswahl 3 im Listenfeld) erfüllt sind.

- Wenn die Bedingung erfüllt ist, soll die ListenfeldAuswahl in der Tabellenspalte und unter der aktiven Zelle eingetragen werden, bis das angegebene Datum erreicht ist.

... bekomme ich nicht zum Laufen :-(

Näheres habe ich im Script beschrieben und außerdem eine Testdatei mit hochgeladen.

Und jetzt der schlimmere Teil (ich hoffe die Profis bekommen keinen Augenkrebs).
Ich habe mir das wie beim Formelschreiben vorgestellt, mit Wenn - Dann - Sonst....habe aber sehr schnell gemerkt, dass ich ohne Schleife nicht weiterkomme, deshalb frage einfach mal frecherweise, ob mir jemand diese Schleife Schreiben könnte... ?

Code:

Option Explicit

Private Sub CommandButton1_Click()

'Auswahl aus Listbox soll immer in aktive Zelle eingetragen werden, wenn ein Datum in in der gleichen Zeile aber in Spalte A vorhanden ist.
'(Funktioniert)
If ActiveCell.Offset(0, -9) "" Then
ActiveCell.Offset(0, 0).Value = ListBox1.Value
Else
If ActiveCell.Offset(0, -9) = "" Then
ActiveCell.Offset(0, 0).Value = ""
End If
End If

' Es erfolgt eine Prüfung ob ein bestimmter Text (von 5) in der ListBox ausgewählt wurde erfolgen (ListBox Auswahl 1 oder Auswahl 3), damit die Datumeingabe in der TextBox zur Eintragung beachtet wird.

If TextBox1.Value "" Then
'eigentlich müßte hier noch eine Prüfung rein, ob das eingetragene Datum überhaupt ein
'Datum, bzw. lesbar ist....

' hier wird leider nur mit der ersten Zelle ("Q4") verglichen (was ist da falsch?)
If ListBox1.Value Range("Q4, Q6") Then
MsgBox ("Um die Funktion TextBox_Datum nutzen zu können, müssen Sie entweder Auswahl 1 oder Auswahl 3 auswählen.")
Exit Sub

'(habe keine Ahnung wie der Code dafür heißt):
' If TextBox1.Value "" Then
' If ListBox1.Value = "überhauptnichts markiert" Then
' MsgBox ("Sie haben nichts markiert aber ein Datum eingetragen.")
' Exit Sub

Else

' "Schleife"
' Datum aus der Userformtextbox mit Datum in Tabelle aus Spalte A
' vergleichen (kleiner / größer)
'
' Prüfen ob das Datum der Userform TextBox in der Vergangenheit liegt (einmal)
' geht leider auch nicht :-(
If ActiveCell.Offset(0, -9) "" Then
If TextBox1.Value < ActiveCell.Offset(0, -9).Value Then
MsgBox ("Bitte überprüfen Sie das eingegebene Datum.")
Exit Sub
End If

Else

' Ab hier würde die Schleife anfangen...(Funktioniert aber auch nicht). Das müßte ich sonst mit jeder Zeile aus 12 Tabellenblättern machen...

' Datum aus Spalte A eine Zeile unter der der Aktiven Zelle prüfen
If ActiveCell.Offset(1, -9) "" Then
If TextBox1.Value > ActiveCell.Offset(1, -9) Then
ActiveCell.Offset(2, 0).Value = ListBox1.Value

' ...nächste Zeile
If ActiveCell.Offset(2, -9) "" Then
If TextBox1.Value > ActiveCell.Offset(2, -9) Then
ActiveCell.Offset(3, 0).Value = ListBox1.Value

'nächste Zeile
If ActiveCell.Offset(3, -9) "" Then
If TextBox1.Value > ActiveCell.Offset(3, -9) Then
ActiveCell.Offset(3, 0).Value = ListBox1.Value

' ...wenn die Datumspalte (A) leer ist, soll im nächsten Tabellenblatt die Datumspalte verglichen, und die Auswahl in der Spalte der Aktiven Zelle eingetragen werden, bis das in die TextBox eingegebene Datum erreicht ist.
' da sich aber mehr als 12 Tabellenblätter befinden, sollten die Prüfungen auf diese 12 Tabellenblätter (Monate) begrenzt bleiben

End If
End If
End If
End If
End If
End If
End If
End If
End If
Unload UserForm1

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Seid bitte nicht so streng in euren Kommentaren, möchte nochmal auf meinen Anfängerstatus hinweisen :-)

Bin für jede Unterstützung dankbar.

B Y E,
Smeargol

:)

rastrans · 13. September 2016

Hallo,

es gibt in diesem Code viele Unklarheiten, was passiert wenn. *frown.gif*

Z.B.: Du bist in der Spalte J am 16.1.. Da steht ein Text drin, was auch immer. wählst du Auswahl 5 aus, dann passiert nichts, weil der Text ja nicht überschrieben werden soll. Egal was du beim Datum einträgst. Das spielt ja noch keine Rolle.
Wählst du Auswahl 1 und ein Datum nach dem 16.1. wird der Text überschrieben!

Aber hier hast du ein Grundgerüst, mit dem du deine Daten entsprechend verändern kannst.

Viele Grüße
rastrans Code:

Private Sub CommandButton1_Click()
Dim i As Integer
Dim lngZeile As Long
Dim lngDatumDifferenz As Long
Dim ws As Worksheet
Dim bol As Boolean

'In der Listbox muss was ausgewählt sein
If ListBox1.ListIndex < 0 Then
MsgBox "In der Listbox ist keine Auswahl getroffen worden!"
Exit Sub
End If
'Im Textfeld muss ein Datum stehen
If Not IsDate(Me.TextBox1.Value) Then
Me.TextBox1.SetFocus
MsgBox "DATUM!!! Ist das so schwer zu verstehen????", vbInformation + vbOKOnly, "DAU-Fehlermeldung"
Exit Sub
End If
'Das aktive Arbeitsblatt muss eines der 12 ersten sein
For i = 1 To 12
bol = StrComp(ActiveSheet.Name, Worksheets(i).Name, vbTextCompare) = 0
If bol Then Exit For
Next
If Not bol Then
MsgBox "Das Arbeitsblatt muss eines der ersten 12 sein!"
Exit Sub
End If

'Wenn die aktive Zelle in Spalte 10 ist, nicht leer und in Spalte A ein Datum steht, dann...
If ActiveCell.Column = 10 And IsDate(Cells(ActiveCell.Row, 1).Value) And IsEmpty(ActiveCell) Then
'...den text aus der Listbox eintragen
ActiveCell.Value = ListBox1.Value
End If

'Wenn die Auswahl mit den Werten aus Q4 oder Q6 identisch ist, dann ...
If ListBox1.Value = Range("Q4").Value Or ListBox1.Value = Range("Q6").Value Then
'... den Text aus Listbox1 vom ersten Arbeitsblatt bis zum Datum in Spalte J eintragen.
'Über die ersten 12 Arbeitsblätter
For i = 1 To 12
With Worksheets(i)
'Ab zeile 4 beginnend
lngZeile = 4
'Differenz der Tage berechnen
lngDatumDifferenz = DateDiff("d", .Cells(lngZeile, 1).Value, Me.TextBox1.Value)
'Solange in Spalte A ein Datum steht und das Datum vor der Eingabe liegt
Do While lngDatumDifferenz >= 0 And IsDate(.Cells(lngZeile, 1).Value)
'Text aus Listbox eintragen
.Cells(lngZeile, 10).Value = ListBox1.Value
'nächste Zeile
lngZeile = lngZeile + 1
'Differenz der Tage berechnen
lngDatumDifferenz = DateDiff("d", .Cells(lngZeile, 1).Value, Me.TextBox1.Value)
'eigentlich kann man hier auch lngDatumDifferenz = lngDatumDifferenz-1 schreiben, aber ich weiss ja nicht, ob du in Spalte A wirklich immer ein richtiges Datum hast.
'Gerade Monate mit weniger als 31 Tagen könnten einen falschen Wert hervorrufen!
Loop
End With
Next i
End If

Unload UserForm1
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Smeargol · 9. Februar 2021

\@rastrans

von rastrans

es gibt in diesem Code viele Unklarheiten, was passiert wenn. *frown.gif*
[/code]
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

...leider, leider...

von rastrans

Z.B.: Du bist in der Spalte J am 16.1.. Da steht ein Text drin, was auch immer. wählst du Auswahl 5 aus, dann passiert nichts, weil der Text ja nicht überschrieben werden soll. Egal was du beim Datum einträgst. Das spielt ja noch keine Rolle.
Wählst du Auswahl 1 und ein Datum nach dem 16.1. wird der Text überschrieben!
[/code]
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

...Funktioniert nur Bruchstückhaft. Ich hatte es aber nur hinbekommen, bei Auswahl 1 die Datumeintragung zu akzeptieren.
Das Datumfeld soll auch nur eine "kann" und keine "und" Möglichkeit sein.
Alle Auswahlmöglichkeiten in der ListBox sollen auch ohne Datumeingabe Ausgewählt, aber dann nur in der aktiven Zelle eingetragen werden können.
Wenn aber ein Datum eingetragen wird, wird NUR unter der Bedingung bis zum angegebenen Datum eingetragen, wenn Auswahl 1 oder Auswahl 3 getroffen wurde (MsgBox anzeigen wenn ein Datum eingetragen, aber keine oder eine andere Auswahl getroffen wurde)

von rastrans

Aber hier hast du ein Grundgerüst, mit dem du deine Daten entsprechend verändern kannst.
[/code]
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das ist ja cool. Vielen Dank (mal wieder *Smilie ) für Deine Mühen...

-----------------------------
Ich habe das Script mal getestet. Bis auf das obige (Datumangabe: kann/muss)....
...es wird nicht ab der aktiven Zelle, sondern immer ab 1. Januar bis zum angegebenen Datum eingetragen.
Ansonsten : VOLL GEIL! (Entschuldigt die Ausdrucksweise.)
-----------------------------

Eine Frage aber noch:
Es wird ja von Tabellenblatt 1 bis 12 durchgezählt...
- müssen das die ersten 12 in meiner Mappe sein ?
oder
- wird nach den "Tabellenechtzahlen" (im VBA-Editor sichtbar) gegangen ?
oder
- kann ich das Script nach Tabellenbezeichnungen (Jan. - Dez.) suchen lassen ?

Supervielendank auch für Deine Kommentare im Script, das wird mir sicher weiterhelfen *Smilie

B Y E,
smeargol

rastrans · 14. September 2016

Man kann das auch nach den Tabellennamen machen, aber deine Namen waren irgendwie blöd. Deswegen bin ich davon ausgegangen, das es die ersten 12 sind.

Ich hatte das so aus deinem Code nicht erkannt. Deswegen bin ich davon ausgegangen, das das Datum ein Pflichtfeld ist.

Du hattest nur gesagt bis zu einem Datum, nicht von wo. also bin ich von Jahresanfang ausgegangen.

rastrans · 14. September 2016

Hallo Smeargol,

die Kontrolle, ob es sich um ein gültiges Datum in deiner Textbox handelt, habe ich in ein Textbox-Event gelegt. Spart viel Arbeit! Ein gültiges Datum muss auch aus diesem Jahr sein!

Deine Tabellen müssen nun alle richtige Monatsnamen haben. Nur diese werden überprüft. Die Tabellen müssen nicht am Anfang stehen und auch nicht in der Reihenfolge sein.
Wenn du in deiner Tabelle 7 (Juli) auch noch in das Feld A4 ein Datum aus dem Juli einträgst, dann kannst du das mit diesem Code machen! Code:

Sub MonatsnamenAlsTabelle()
Dim i As Integer
For i = 1 To 12
Worksheets(i).Name = MonthName(Month(Worksheets(i).Cells(4, 1).Value))
Next i
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ob das Datum vor oder nach dem Startdatum liegt, ist egal!

Viele Grüße
rastrans Code:

Private Sub CommandButton1_Click()
Dim i As Integer
Dim lngZeile As Long, intZeileAdd As Integer
Dim datDatumEnde As Date
Dim lngDatumDifferenz As Long
Dim ws As Worksheet
Dim bol As Boolean

'In der Listbox muss was ausgewählt sein
If ListBox1.ListIndex < 0 Then
MsgBox "In der Listbox ist keine Auswahl getroffen worden!"
Exit Sub
End If
For i = 1 To 12
bol = StrComp(ActiveSheet.Name, Worksheets(i).Name, vbTextCompare) = 0
If bol Then Exit For
Next
If Not bol Then
MsgBox "Das Arbeitsblatt muss eines der Monatsblätter sein!"
Exit Sub
End If

bol = IsDate(Me.TextBox1.Value)
datDatumEnde = IIf(bol, Me.TextBox1.Value, Cells(ActiveCell.Row, 1).Value)
intZeileAdd = Sgn(DateDiff("d", Cells(ActiveCell.Row, 1).Value, datDatumEnde))

If intZeileAdd 0 And Not (ListBox1.Value = Range("Q4").Value Or ListBox1.Value = Range("Q6").Value) Then
MsgBox "Diese Auswahl darf nur ohne Datum ausgewählt werden!", vbExclamation + vbOKOnly
Exit Sub
End If

lngZeile = ActiveCell.Row
Set ws = ActiveCell.Parent
Do
ws.Cells(lngZeile, 10).Value = ListBox1.Value
bol = DateDiff("d", ws.Cells(lngZeile, 1).Value, datDatumEnde) = 0
If Not bol Then
lngZeile = lngZeile + intZeileAdd
If Not IsDate(ws.Cells(lngZeile, 1)) Then
Set ws = Worksheets(MonthName(Month(DateAdd("d", intZeileAdd, ws.Cells(lngZeile - intZeileAdd, 1).Value))))
lngZeile = IIf(lngZeile < 4, ws.Cells(4, 1).End(xlDown).Row, 4)
End If
End If
Loop Until bol

Unload UserForm1
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Len(Me.TextBox1.Value) > 0 Then
If Not IsDate(Me.TextBox1.Value) Then
MsgBox "Entweder leer lassen oder ein gültiges Datum eintragen!"
Cancel = True
ElseIf Year(Me.TextBox1.Value) Year(Cells(ActiveCell.Row, 1).Value) Then
MsgBox "Datum nicht gefunden!"
Cancel = True
End If
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Smeargol · 9. Februar 2021

Hallo rastrans,

von rastrans

Hallo Smeargol,

die Kontrolle, ob es sich um ein gültiges Datum in deiner Textbox handelt, habe ich in ein Textbox-Event gelegt. Spart viel Arbeit! Ein gültiges Datum muss auch aus diesem Jahr sein!

Deine Tabellen müssen nun alle richtige Monatsnamen haben. Nur diese werden überprüft. Die Tabellen müssen nicht am Anfang stehen und auch nicht in der Reihenfolge sein.
Wenn du in deiner Tabelle 7 (Juli) auch noch in das Feld A4 ein Datum aus dem Juli einträgst, dann kannst du das mit diesem Code machen! Code:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Sub MonatsnamenAlsTabelle()
Dim i As Integer
For i = 1 To 12
Worksheets(i).Name = MonthName(Month(Worksheets(i).Cells(4, 1).Value))
Next i
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Also...schäm..ja, den Juli habe ich übersehen *Smilie
In meinen richtigen Tabellenblättern steht in Spalte A immer ein gültiges Datum.

Das ist ja ein witziges Script *grins Hat super funktioniert... kommt gleich in meine Toolbox. Danke dafür.

Ob das Datum vor oder nach dem Startdatum liegt, ist egal!
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

..also auch "Rückwirkende" Eintragungen möglich...super.

Code:

Private Sub CommandButton1_Click()
Dim i As Integer
Dim lngZeile As Long, intZeileAdd As Integer
Dim datDatumEnde As Date
Dim lngDatumDifferenz As Long
Dim ws As Worksheet
Dim bol As Boolean

'In der Listbox muss was ausgewählt sein
If ListBox1.ListIndex < 0 Then
MsgBox "In der Listbox ist keine Auswahl getroffen worden!"
Exit Sub
End If
For i = 1 To 12
bol = StrComp(ActiveSheet.Name, Worksheets(i).Name, vbTextCompare) = 0
If bol Then Exit For
Next
If Not bol Then
MsgBox "Das Arbeitsblatt muss eines der Monatsblätter sein!"
Exit Sub
End If

bol = IsDate(Me.TextBox1.Value)
datDatumEnde = IIf(bol, Me.TextBox1.Value, Cells(ActiveCell.Row, 1).Value)
intZeileAdd = Sgn(DateDiff("d", Cells(ActiveCell.Row, 1).Value, datDatumEnde))

If intZeileAdd 0 And Not (ListBox1.Value = Range("Q4").Value Or ListBox1.Value = Range("Q6").Value) Then
MsgBox "Diese Auswahl darf nur ohne Datum ausgewählt werden!", vbExclamation + vbOKOnly
Exit Sub
End If

lngZeile = ActiveCell.Row
Set ws = ActiveCell.Parent
Do
ws.Cells(lngZeile, 10).Value = ListBox1.Value
bol = DateDiff("d", ws.Cells(lngZeile, 1).Value, datDatumEnde) = 0
If Not bol Then
lngZeile = lngZeile + intZeileAdd
If Not IsDate(ws.Cells(lngZeile, 1)) Then
Set ws = Worksheets(MonthName(Month(DateAdd("d", intZeileAdd, ws.Cells(lngZeile - intZeileAdd, 1).Value))))
lngZeile = IIf(lngZeile < 4, ws.Cells(4, 1).End(xlDown).Row, 4)
End If
End If
Loop Until bol

Unload UserForm1
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Len(Me.TextBox1.Value) > 0 Then
If Not IsDate(Me.TextBox1.Value) Then
MsgBox "Entweder leer lassen oder ein gültiges Datum eintragen!"
Cancel = True
ElseIf Year(Me.TextBox1.Value) Year(Cells(ActiveCell.Row, 1).Value) Then
MsgBox "Datum nicht gefunden!"
Cancel = True
End If
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

DAS IST JA DER HAMMER !
Nach dem ändern der Namen der Tabellenblätter läuft das Script ohne Fehler und ohne Ergänzungen meinerseits sowas von flüssig...

Ich brauche das ja nur noch an meine Tabellen anzupassen *boah

Du hast jemanden gerade sehr glücklich gemacht *Smilie

Vielen Dank und fühle Dich virtuell gedrückt *knuddel

Ich habe nochmal die fertige Datei mit dem funktionierenden Script von rastrans hochgeladen.

...und bis zum nächsten Problem *grins

B Y E,
Smeargol

P.S. Meine Bewertung für Deinen Beitrag hole ich später nach. Ich muß erst noch mehr Beiträge anderer Mitglieder bewerten.
.

Smeargol · 15. September 2016

Sodele, ich hab´s übertragen und was soll ich sagen: Es läuft Super. Vielen Dank.

ähem...eine Frage hätte ich da noch.....aber traue mich kaum....

Das Script ist, so wie es ist, Perfekt für mich.

....aber mir ist da..... also .... eine Schwierigkeitsstufe hätte ich da noch .. ?!

Nun ja....ich würde gerne noch eine Eintragungsvariante der beiden Auswahlmöglichkeiten (in Verbindung mit TextBoxDatum) in der ListBox
zufügen, die von einer anderen Bedingung abhängig ist.
Und zwar 5 Tage/Woche und 7 Tage/Woche

Ich würde gerne, z.B. durch jeweils ein Kreuz in einer Zelle (auf Tabelle1), jeder Auswahl eine der beiden Eintragungsvarianten
zuweisen könnte.

Also 7 Tage/Woche = durchgehend Eintragen (inkl.Feiertage)
5 Tage/Woche = Sa und So und Feiertage auslassen

Ich hoffe, dass das nicht zu vermessen von mir ist danach zu fragen.....für mich hört sich das nämlich nach viel Arbeits- und Zeitaufwand an....

Wie gesagt, ich freue mich schon über das bisherige Script und lasse diesen Thread deshalb auch geschlossen.

B Y E,
Smeargol

P.S. Okay, habe gerade gemerkt, wie aufwendig das Einbinden von Feiertagsberechnungen ist......das wird wohl nix.
.

rastrans · 15. September 2016

Hallo Smeargol,

in deiner UserForm fehlt jetzt noch ein Button mit dem Namen CheckBox1. Die Bezeichnung sollte aussagen Wochenende eintragen.

Wenn diese CheckBox markiert ist, dann werden die Wochenenden auch gefüllt. Die Checkbox wird nicht beachtet, wenn kein Datum in TextBox eingetragen wurde!

Veile Grüße
rastrans Code:

lngZeile = ActiveCell.Row
Set ws = ActiveCell.Parent
Do
If Me.CheckBox1.Value Or Weekday(ws.Cells(lngZeile, 1).Value, vbMonday) < 6 Or intZeileAdd = 0 Then
ws.Cells(lngZeile, 10).Value = ListBox1.Value
End If
bol = DateDiff("d", ws.Cells(lngZeile, 1).Value, datDatumEnde) = 0
If Not bol Then
lngZeile = lngZeile + intZeileAdd
If Not IsDate(ws.Cells(lngZeile, 1)) Then
Set ws = Worksheets(MonthName(Month(DateAdd("d", intZeileAdd, ws.Cells(lngZeile - intZeileAdd, 1).Value))))
lngZeile = IIf(lngZeile < 4, ws.Cells(4, 1).End(xlDown).Row, 4)
End If
End If
Loop Until bol
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Die roten Zeilen hinzufügen!

rastrans · 15. September 2016

Ich war nicht ganz zufrieden!

ersetze mal noch die oben rot markierte Zeile durch Code:

If Me.CheckBox1.Value Or Arbeitstag(ws.Cells(lngZeile, 1).Value) = 0 Or intZeileAdd = 0 Then
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

und fürge den Code hinzu Code:

Private Function Arbeitstag(ByVal Datum As Date) As Integer
'Rückgabe
' 0 := Arbeitstag
' 1 := Samstag
' 2 := Sonntag
' +4:= Feiertag
'Neujahr, 1.Mai, Tag der deutschen Einheit, 1. und 2. Weihachtsfiertag
Const c_FesteFeiertage = "*0101*0105*0310*2512*2612*"

Dim intArbeitstagIndex As Integer
Dim intOsternTag As Integer
Dim datOstersonntag As Date
Dim aryBeweglicheFeiertage
Dim intDiffOsterSonntag

intArbeitstagIndex = Weekday(Datum, vbSaturday)
intArbeitstagIndex = IIf(intArbeitstagIndex > 2, 0, intArbeitstagIndex)
Arbeitstag = intArbeitstagIndex

'Fester Feiertag?
If InStr(1, c_FesteFeiertage, Format(Datum, "\*ddmm\*")) Then
Arbeitstag = intArbeitstagIndex + 4
Exit Function
End If

'Beweglicher Feiertag. Ostersonntag +x ist ein Feiertag:
'Karfreitag, Ostersonntag, Ostermontag, Himmelfahrt, Pfingsten
aryBeweglicheFeiertage = Array(-2, 0, 1, 39, 50)
datOstersonntag = OsterSonntag(Year(Datum))
intOsternTag = Day(datOstersonntag)
For Each intDiffOsterSonntag In aryBeweglicheFeiertage
If Datum = DateAdd("d", intDiffOsterSonntag, datOstersonntag) Then
Arbeitstag = intArbeitstagIndex + 4
Exit Function
End If
Next
End Function

Private Function OsterSonntag(Jahr As Integer) As Date
Dim sglTag As Single

sglTag = (((255 - 11 * (Jahr Mod 19)) - 21) Mod 30) + 21
OsterSonntag = DateSerial(Jahr, 3, 1) + sglTag + (sglTag > 48) + 6 - ((Jahr + Jahr \ 4 + sglTag + (sglTag > 48) + 1) Mod 7)
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Dann werden nicht nur die Wochenenden, sondern auch die Feiertage berücksichtigt!

Smeargol · 18. September 2016

Hallo rastrans.

Ich danke dir vielmals.... das ist echt...sowas von GEIL!

Ich bin noch dabei, dieses Script für verschiedene Spalten meiner Arbeitsmappe anzupassen, kann aber schon sagen : Es funktioniert! *grins

Habe auch nochmal die Testdatei mit dem (kompletten) funktionierenden Script von rastrans hochgeladen..

Vielen, vielen Dank.

B Y E,
Smeargol

Office: Schleife?

Schleife?

Schleife?

Schleife?

Schleife?

Schleife? - Similar Threads - Schleife

Verkettung von Zellen - Schleife

While-Schleife wird nicht beendet

For Next Schleife

VBA Schleife kopieren und einfügen von Spalten

Eine Schleife mit zwei tebellen vba Access

Bestimmte Daten zwischen innerhalb eines Datumsbereichs einer Tabelle Anfügen

VBA Loop : Werte suchen und löschen