WorksheetFunction.NetworkDays_Intl

[hewile]

Hallo in die Runde,
ich möchte in VBA zwischen 2 Datumsangaben die Nettoarbeitstage abzüglich Feiertage berechnen. Das funtioniert einwandfrei, bis auf die Feiertage. Ich kann eine einzelne Zelle mit einem Feiertag angeben, aber keinen Bereich. Hier brauche ich eure Hilfe...

 'Tage berechnen
LetzteZeile = ThisWorkbook.Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LetzteZeile
Worksheets(2).Cells(i, 9).Value = WorksheetFunction.NetworkDays_Intl(Cells(i, 6), Cells(i, 7), 1, Cells(2, 15))
Next i

Die Angabe Cells(2, 15) ist der eine Feiertag. Wie gebe ich einen Bereich an (z.B. Cells(2, 15) bis Cells(20, 15))? Am Besten ein Bereich auf einem anderen Tabellenblatt.

Gruß
hewile

[RPP63]

Moin!
Eine oder mehrere Zellen sind ein Range().
Beachte auch, dass immer korrekt referenziert werden sollte!
Cells(i, 6) bezieht sich immer auf das ActiveSheet.

Code:

Dim i&
LetzteZeile = ThisWorkbook.Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LetzteZeile
  With Worksheets(2)
   .Cells(i, 9).Value = _
    WorksheetFunction.NetworkDays_Intl(.Cells(i, 6), .Cells(i, 7), 1, Worksheets("Feiertage").Range("O2:O15"))
  End With
Next i

Gruß Ralf

[hewile]

Perfekt, Danke!!

Viele Grüße
hewile

[hewile]

Hallo Ralf,
aus Geschwindigkeitsgründen soll die Berechnung der Nettorbeitstage in einem Array erfolgen. Die Feiertage sind im Array arrFT hinterlegt. Ich habe jetzt keinen Schimmer, wie ich den zu durchsuchenden Bereich in der Funktion angeben kann (die Fragezeichen müssen durch die Bereichsangabe ersetzt werden, auskommentiert die ursprüngliche Bereichsangabe).






Gruß
hewile

[RPP63]

Moin mal wieder!
Wenn es Dir um Geschwindigkeit geht, solltest Du auf die Berechnung mittels VBA verzichten und statt dessen (mit VBA) Formeln in Zellen schreiben.
Schließlich nutzt Excel alle verfügbaren Prozessorkerne, während das archaische VBA nur einen Kern nutzen kann.

Ich habe mal was vorbereitet. 
Führe in einer neuen Datei folgendes Makro aus.
Es schreibt 2.000 Zeiträume (Start in 2023, Ende in 2024) in die Tabelle.
Ferner wird eine Auflistung aller Feiertage (NRW) in I2, spillend bis J13 geschrieben.

Code:

Sub Fill2000Dates()
Cells.Clear
Range("A1:C1") = Split("Start Ende Arbeitstage")
'Start in 2023, Ende in 2024, 2000 Daten
Range("A2:B2").Formula2Local = "=Datum(2022+SPALTE();1;ZUFALLSMATRIX(2000;;1;365;1))"
With Range("A:B")
   .Copy
   .PasteSpecial xlPasteValues
   .NumberFormatLocal = "TT.MM.JJJJ"
End With
'Feiertage 2023 bis 2024 in I1#
Range("I1").Formula2Local = _
  "=LET(Jahre;SEQUENZ(;2;2023);" & _
  "FFT;DATUM(Jahre;1;{1;121;276;305;359;360})+WENN(MONAT(DATUM(Jahre;2;29))=2;{0;1;1;1;1;1});" & _
  "OFT;RUNDEN((TAG(MINUTE(Jahre/38)/2+55)&"".4.""&Jahre)/7;)*7-6+{-2;0;1;39;49;50;60};" & _
  "SORTIEREN(VSTAPELN(FFT;OFT)))"
Range("I:J").NumberFormatLocal = "TT.MM.JJJJ"
End Sub

Jetzt berechnest Du alle 2.000 Zeiträume per Formel.
Die Formel wird gegen den Wert getauscht.
Das Ergebnis der Dauer des Makrodurchlaufs wird in den Direktbereich geschrieben.
Bei mir dauert dies 0,04 Sekunden!
Das dürfte kein Array schneller schaffen!

Code:

Sub Testlauf()
Dim Start As Double
Start = Timer
Application.ScreenUpdating = False
With Range("C2:C2001")
  .FormulaLocal = "=NETTOARBEITSTAGE.INTL(A2;B2;1;I$1#)"
  .Copy
  .PasteSpecial xlPasteValues
End With
With Application
  .ScreenUpdating = True
  .CutCopyMode = False
  .GoTo Cells(1)
End With
Debug.Print Timer - Start
End Sub

Gruß Ralf

[RPP63]

Dafür, dass Du mir die "Dringlichkeit" per PN mitteiltest und auch hier mitgelesen hast, empfinde ich die Funkstille sonderbar!

[hewile]

Hallo Ralf,
das ist genial!! ca. 900.000 Werte berechnen und in die Zellen schreiben in 3 Sekunden...

Wünsche dir und deiner Familie schöne Weihnachten!

Gruß hewile