16. juli 2009 - 22:58Der er
12 kommentarer og 1 løsning
Antal arbejdsdage mellem 2 datoer
Hej !
I forbindelse med excel regneark har jeg oprettet en Userform, hvor der indtastes en startdato og en slutdato, ved OK beregner funktionen <Datediif> forskellen mellem startdato og slutdato i antal år, mdr., dg,.
Spørgsmål: Er der nogen som kan hjælpe med en VBA kode som kan klare og udregne hvor mange arbejdsdage der er mellem den indtastede startdato og slutdato, - det kan <Datediif> desværre ikke klare.
- Håber der er nogen som kan komme med et godt forslag. - Jeg kender godt funktionen <Antal.arbejdsdage> som kan gøre det på et Excelark, men venter på en god VBA kode ????
Hej ! Har modtaget dit forslag, - det er bare perfekt, det var lige det jeg manglede. Endelig kan jeg blive færdig med mit lille projekt.
Jeg har dog et lille tillægsspørgsmål til dit forslag som jeg lige har forsøgt og løse men det lod sig ikke gøre for mig, det er følgende: Når din kode har udregnet antallet af arbejdsdage f.eks. 20 dage, hvorledes de 21 dage så ganges med 07:24 time. I excel går det jo ud på og få cellerne formateret rigtigt, men kan det gøres med VBA.
- Dit fremsendte forslag var lige det jeg manglede og bruger.
Selv tak - du får et svar. Vender tilbage vedr. dit spørgsmål...
Koden i Userform: Rem EVT. JUSTERING VEDR.: Rem Grundlovsdag, Juleaftensdag & Nytårsaftensdag Rem Disse tælles IKKE med som arbejdsdage p.t. Rem ============================================= Dim hÅr As Integer, påskeDag As Date Dim hDageFaste As Variant, hDageVar As Variant
Dim fraDag As Date, tilDag As Date Dim antalArbejdsDage As Integer Private Sub CommandButton1_Click() 'Beregn Dim dag As Date fraDag = Me.TextBox1 tilDag = Me.TextBox2 hÅr = 0
antalArbejdsDage = 0
For dag = fraDag To tilDag Rem opsætning af helligdage for året If hÅr = 0 Or hÅr <> Year(dag) Then påskeDag = beregnPåske(Year(dag)) opsætningAfHelligDage påskeDag hÅr = Year(dag) End If
Rem undersøg om helligdag If erDetHelligdag(dag) = False Then Rem Hvis nej - test om lør/søn If Weekday(dag, vbMonday) < 6 Then antalArbejdsDage = antalArbejdsDage + 1 End If End If Next dag
Me.Label4 = antalArbejdsDage
End Sub Public Function beregnPåske(aar)
Rem Beregning af Paaske - 1900 - 2099 Rem ================================= Dim d, E, Q b1 = aar Mod 19 d = 225 - (11 * b1)
If d > 50 Then While d > 50 d = d - 30 Wend End If
If d > 48 Then d = d - 1 End If
E = (aar + Int(aar / 4) + d + 1) Mod 7
Q = d + 7 - E
If Q < 32 Then m = "03" Else m = "04" Q = Q - 31 End If
beregnPåske = CStr(Q) + "-" + m + "-" + CStr(aar) End Function Public Sub opsætningAfHelligDage(påskeDag) Rem Faste
Rem Skærtorsdag hDageVar(0) = Format(DateAdd("d", -3, påskeDag), "dd-mm")
Rem Langfredag hDageVar(1) = Format(DateAdd("d", -2, påskeDag), "dd-mm")
Rem Påskedag hDageVar(2) = Format(påskeDag, "dd-mm")
Rem 2. Påskedag hDageVar(3) = Format(DateAdd("d", 1, påskeDag), "dd-mm")
Rem St. Bededag hDageVar(4) = Format(DateAdd("ww", 4, hDageVar(1)), "dd-mm")
Rem Kr. Himmelfart hDageVar(5) = Format(DateAdd("ww", 6, hDageVar(0)), "dd-mm")
Rem Pinsedag hDageVar(6) = Format(DateAdd("ww", 7, påskeDag), "dd-mm")
Rem 2. Pinsedag hDageVar(7) = Format(DateAdd("d", 1, hDageVar(6)), "dd-mm") End Sub Public Function erDetHelligdag(testDato) Dim f, dato As String dato = Format(testDato, "dd-mm")
Rem Faste helligdage For f = 0 To 5 If hDageFaste(f) = CStr(dato) Then erDetHelligdag = True Exit Function End If Next f
Rem Variable For f = 0 To 7 If hDageVar(f) = dato Then erDetHelligdag = True Exit Function End If Next f
erDetHelligdag = False End Function Private Sub CommandButton2_Click() 'Luk gemIndstillinger
Unload UserForm1 End Sub Private Sub UserForm_activate() læsIndstillinger End Sub Private Sub læsIndstillinger() Me.CheckBox1 = sætCheckbox(2, 3) Me.CheckBox2 = sætCheckbox(3, 3) Me.CheckBox3 = sætCheckbox(4, 3) End Sub Private Function sætCheckbox(ræk, kol) With ActiveWorkbook.Sheets("Indstillinger") If .Cells(ræk, kol) = "x" Then sætCheckbox = True Else sætCheckbox = False End If End With End Function Private Sub gemIndstillinger() sætIndstilling 2, 3, Me.CheckBox1.Value sætIndstilling 3, 3, Me.CheckBox2.Value sætIndstilling 4, 3, Me.CheckBox1.Value End Sub Private Sub sætIndstilling(ræk, kol, værdi) With ActiveWorkbook.Sheets("Indstillinger") If værdi = True Then .Cells(ræk, kol) = "x" Else .Cells(ræk, kol) = "" End If End With End Sub
Hej Tak for den fremsendte kode vedr. mit sidste spørgsmål, der må have været en fejl i koden (den ene variabel), men jeg kan se hvad det går ud på, og med lidt rettelser virker det næsten perfekt nu, jeg har testet det på et excelark, der er blot lige det at hvis resultatet bliver over 24:00 timer så vises det forkert på mit excelark. - Men jeg prøver mig lidt frem. - Selvom det sidste ikke virker helt endnu accepterer jeg dit svar/kode for det er den jeg bruger.
Hej Har fået alt til og virke nu, rettede lidt på typen af variabler, m.m.
Tak for hjælpen, så lærte jeg lidt om datoer og tid.
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
