Beräkna antal dagar men utesluta lördag och söndag

[Mile]

Hej!

 

Hjälp mig snälla med att beräkna antal dagar mellan två datum men utesluta lördag och söndag

 

MVH

Mile

 

[inlägget ändrat 2007-03-13 09:23:48 av Mile]

[inlägget ändrat 2007-03-13 10:33:16 av Mile]

[Erki]

Nu skriver du att du vill utesluta lördagar och söndagar. Nu vet jag inte vad du villa använda detta för men troligen ska du även utesluta helgdagar som infaller på m-fr också. Jag skrev en gång en rutin som du hittar här //eforum.idg.se/viewmsg.asp?EntriesId=519066#519077 för att avgöra om ett datum var helgdag. Ihopkopplat med detta http://www.tek-tips.com/faqs.cfm?fid=261 har du en lösning.

 

[Zilver Ztream]

Hej.

 

Tror du är ute efter något liknande.

Denna funktion tar två datum och utesluter sedan Lördag och Söndag (perfekt för att kolla antalet arbetsdagar)

 

  Public Function Arbetsdagar(sStartDatum, sEndDatum)
   Dim iDagar
   Dim iArbetsDagar
   Dim sDag
   Dim i

   iDagar = DateDiff("d", sStartDatum, sEndDatum)

   iArbetsDagar = 0

   For i = 0 To iDagar
     'Första dagen på veckan är Söndag
     sDag = Weekday(DateAdd("d", i, sStartDatum))
     If sDag <> 1 And sDag <> 7 Then
       iArbetsDagar = iArbetsDagar + 1
     End If
   Next
   Arbetsdagar = iArbetsDagar
 End Function

 

Hoppas den gör dig någon nytta.

 

 

MVH

Dennis

 

[Mile]

Tack för tipset,

 

ska testa så fort hinner:thumbsup:

 

 

 

[Mile]

Hej igen!

 

Tack för tipset, men jag har ställt fråga på fel sätt. Sorry

 

Det som jag vill komma åt är följande ex.

 

Jag vill beräkna en "start datum" utifån en annan "slut datum" minus t.ex 10 "arbetsdagar".

 

"slut datum" (2007-03-26) - 10 "arbetsdagar" = "start datum" (2007-03-12)

 

Tacksam för alla tips

 

 

 

 

 

 

[Erki]

Beroende på om du vill räkna bort röda dagar eller ej modifierar du antingen mitt eller Zilver Ztreams förslag.

Vad du istället får göra är att utifrån ett startdatum

1. stega en dag bakåt

2. Testa om den är en arbetsdag (enligt lämplig definition)

3. Är den en arbetsdag öka en räknare med 1

4. Fortsätt att stega en dag bakåt i taget tills räknaren är 10.

 

[Mile]

Hej igen!

 

Har du lust att skriva detta i kod eftersom jag är inte så duktig.

Självklart jag vill utesluta "röda dagar"

 

MVH

Mile

 

 

[Erki]

Återkommer under kvällen.

 

[Erki]

Skapa dessa två funktioner i en modul

[log]

Public Function ArbDag(Indatum) As Boolean 'Resultat False för Lördag, Söndag och helgdag Sant för övriga
Dim Veckodag, Year, A, B, C, D, E, F As Integer
Dim EasterDay As Date

Select Case DatePart("w", Indatum, vbMonday, vbFirstFourDays)
Case 6, 7
ArbDag = False ' Indatum är en lördag eller Söndag
Exit Function
Case Else ' Tillsvidare vet vi att det är en Må-Fr

If DatePart("m", Indatum, vbMonday, vbFirstFourDays) = 1 And (DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 1 Or DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 6) Then
ArbDag = False 'Indatum är Nyårsdag eller trettondag
Exit Function
End If

If DatePart("m", Indatum, vbMonday, vbFirstFourDays) = 5 And DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 1 Then
ArbDag = False 'Indatum är 1:a maj
Exit Function
End If

If DatePart("m", Indatum, vbMonday, vbFirstFourDays) = 12 And (DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 24 Or DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 25 Or DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 26 Or DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 31) Then
ArbDag = False 'Indatum är Julafton,Juldag, Annandag eller Nyårsafton
Exit Function
End If

If DatePart("m", Indatum, vbMonday, vbFirstFourDays) = 6 And (DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 6) Then
ArbDag = False 'Indatum är nationaldagen 6 Juni
Exit Function
End If

' Hitta påskdag, Easterday
Year = DatePart("yyyy", Indatum, vbMonday, vbFirstFourDays)


m = 24 'Konstant giltig till 2199
N = 5 'Konstant giltig till 2099
A = Year Mod 19
B = Year Mod 4
C = Year Mod 7
D = (19 * A + m) Mod 30
E = (2 * B + 4 * C + 6 * D + N) Mod 7
F = 22 + D + E
If F = 57 Or (F = 56 And E = 6 And A > 10) Then F = F - 7

If F <= 31 Then
EasterDay = CDate(Year & "-" & "03-" & F)

Else
EasterDay = CDate(Year & "-" & "04-" & D + E - 9)

End If
'Hitta LångFredag AnnandagPåsk Kristihimmelsfärdsdag
If Indatum = EasterDay - 2 Or Indatum = EasterDay + 1 Or Indatum = EasterDay + 39 Then
ArbDag = False
Exit Function
End If
End Select
ArbDag = True 'Om Indatum inte är helgdag
End Function

Public Function WorkdayDiff(EndDate As Date, Period As Integer)
'Stop
Dim Startdate As Date
Dim Steps As Integer
Startdate = EndDate
Do
Startdate = Startdate - 1
If ArbDag(Startdate) Then

       Steps = Steps + 1
   End If

Loop Until Steps = Period
WorkdayDiff = Startdate
End Function

[/log]

 

Funktionen anropes genom att skriva WorkdayDiff(Datum, antal dagar)

 

t ex WorkdayDiff(#2007-01-18#,17)

vilket ger 2006-12-21

 

Du förstår kanske själv principen hur undantagen räknas fram. Här är inte dagar typ Allhelgonaafton eller skärtorsdag borttagna. Ska de också bort lägger du enkelt till dessa.

 

[Mile]

Tack Erki!

:thumbsup::thumbsup:

 

Ska testa då fort jag hinner.

 

Tror du att man kan fixa en tabel där man skriver datum som man vill utesluta vid en sån beräkning, för att t.ex. skappa en kalender där semmestarveckor tas bort mm.

 

MVH

Mile

 

[Erki]

Skapa en tabell som du döper till tblDatumUndantag med ett fält som heter Datum. Vill du ha ytterligare fält t ex beskrivningar går det bra också.

 

Om du ersätter koden i den första funktionen fram till första Select Case satsen med denna kod ska det fungera. Först måste du dock i VBA-editorn gå in under Verktyg > Referenser och leta rätt på en rad 'Microsoft DAO 3.6 Object Library' och bocka för den.

 

 

 

Public Function ArbDag(Indatum) As Boolean 'Resultat False för Lördag, Söndag och helgdag Sant för övriga
Dim Veckodag, Year, A, B, C, D, E, F As Integer
Dim EasterDay As Date
Dim dbs As Database
Dim rst As DAO.Recordset

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblDatumUndantag", dbOpenTable)
rst.Index = "Datum"
rst.Seek "=", Indatum

If rst.NoMatch Then
   rst.Close

Else
       ArbDag = False ' En undantagsdag hittades
       rst.Close
       Exit Function
End If

 

[Mile]

Tack Erki!

 

:thumbsup::thumbsup:

 

Jag har två frågor till:

 

1. Du har skrivit "Om du ersätter koden i den första funktionen fram till första Select Case satsen med denna kod ska det fungera"

Jag förstår inte var någonstans ska man ersätta koden?

 

2. Hur ska jag beräkna en datum i en Formulär med hjälp av en sån tabel/kod

d.v.s

Jag vill tex. beräkna (STANDARDVÄRDE) på start datum utifrån ett slut datum minus t.ex. 10 dagar (självklart att röda dagar samt datum som står i tabel ska uteslutas)

 

Som du ser utifrån mina frågor vilken liten kunskap har jag,

men med din hjälp blir det bättre eller hur?

 

Tack en gång till!

 

 

 

 

 

[Erki]

Första frågan: Du skulle ha bytt ut de första fyra raderna i den första koden jag klistrade in här den 14:e.

 

Du kan byta ut hela koden i första funktionen mot denna.

 

[log]

Public Function ArbDag(Indatum) As Boolean 'Resultat False för Lördag, Söndag och helgdag Sant för övriga
Dim Veckodag, Year, A, B, C, D, E, F As Integer
Dim EasterDay As Date
Dim dbs As Database
Dim rst As DAO.Recordset

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblDatumUndantag", dbOpenTable)
rst.Index = "Datum"
rst.Seek "=", Indatum

If rst.NoMatch Then
   rst.Close

Else
       ArbDag = False ' En undantagsdag hittades
       rst.Close
       Exit Function
End If

Select Case DatePart("w", Indatum, vbMonday, vbFirstFourDays)
Case 6, 7
ArbDag = False ' Indatum är en lördag eller Söndag
Exit Function
Case Else ' Tillsvidare vet vi att det är en Må-Fr

If DatePart("m", Indatum, vbMonday, vbFirstFourDays) = 1 And (DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 1 Or DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 6) Then
ArbDag = False 'Indatum är Nyårsdag eller trettondag
Exit Function
End If

If DatePart("m", Indatum, vbMonday, vbFirstFourDays) = 5 And DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 1 Then
ArbDag = False 'Indatum är 1:a maj
Exit Function
End If

If DatePart("m", Indatum, vbMonday, vbFirstFourDays) = 12 And (DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 24 Or DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 25 Or DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 26 Or DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 31) Then
ArbDag = False 'Indatum är Julafton,Juldag, Annandag eller Nyårsafton
Exit Function
End If

If DatePart("m", Indatum, vbMonday, vbFirstFourDays) = 6 And (DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 6) Then
ArbDag = False 'Indatum är nationaldagen 6 Juni
Exit Function
End If

' Hitta påskdag, Easterday
Year = DatePart("yyyy", Indatum, vbMonday, vbFirstFourDays)


m = 24 'Konstant giltig till 2199
N = 5 'Konstant giltig till 2099
A = Year Mod 19
B = Year Mod 4
C = Year Mod 7
D = (19 * A + m) Mod 30
E = (2 * B + 4 * C + 6 * D + N) Mod 7
F = 22 + D + E
If F = 57 Or (F = 56 And E = 6 And A > 10) Then F = F - 7

If F <= 31 Then
EasterDay = CDate(Year & "-" & "03-" & F)

Else
EasterDay = CDate(Year & "-" & "04-" & D + E - 9)

End If
'Hitta LångFredag AnnandagPåsk Kristihimmelsfärdsdag
If Indatum = EasterDay - 2 Or Indatum = EasterDay + 1 Or Indatum = EasterDay + 39 Then
ArbDag = False
Exit Function
End If
End Select
ArbDag = True 'Om Indatum inte är helgdag
End Function

[/log]

 

 

Fråga två:

Om du i ditt formulär skapar tre kontroller i form av textrutor.

1. tbForskjutning, Standardvärde 10

2.tbSlutDatum, Format KortDatum

3.tbStartDatum, Format Kort Datum

 

För tbSlutdatum skapar du en händelse för 'Efter uppdatering' med kodverktyget. Skriv

Me.tb_Startdatum = WorkdayDiff(Me.tbSlutDatum, Me.tbForskjutning)

 

När du skrivit ett datum i tbSlutdatum kommer tbStartdatum att fyllas med ett datum 10 arbetsdagar före slutdatum. Skriver du ett annat värde i tbFoskjutning så ändras tidsdiffen i motsvarande grad.

 

[Mile]

Tack Erki!

 

Ska försöka fixa enligt dina instruktioner.

återkommer säkert med flera "dumma frågor"

hoppas att du kan hjälpa mig som du gjort hittills.

 

Ha en trevlig hälg!

 

[Erki]

Jag såg att det smugit sig in ett fel i koden i föregående inlägg. Slutet ska vara

 

För tbSlutdatum skapar du en händelse för 'Efter uppdatering' med kodverktyget. Skriv

Me.[color="#ff0000"]tbStartdatum[/color] = WorkdayDiff(Me.tbSlutDatum, Me.tbForskjutning)

 

 

När du skrivit ett datum i tbSlutdatum kommer tbStartdatum att fyllas med ett datum 10 arbetsdagar före slutdatum. Skriver du ett annat värde i tbFoskjutning så ändras tidsdiffen i motsvarande grad.

 

[Mile]

Hej Erki!

 

Jag har testat sista koden och allting fungera som ska:thumbsup:

Jag är jätteglad.

 

Tänkte fråga dig om man kan skappa Verifieringsuttryck på tbSlutDatum

där man inte tillåter att slutdatum väljs som "ej arbetsdag"

 

Tack en gång för din hjälp

MVH

Mile

 

 

 

[Erki]

Jag har aldrig arbetat med Access Verifieringsuttryck. Om behov uppstår brukar jag koda det själv. T ex kan du i den koden jag skrev i förra inlägget ändra till

 

[color="#ff0000"]If ArbDag(Me.tbSlutdatum) = False Then
MsgBox("Datumet du valt som slutdatum är inte en arbetsdag!")
Me.tbSlutdatum =""
Else[/color]
Me.tbStartdatum = WorkdayDiff(Me.tbSlutDatum, Me.tbForskjutning)
[color="#ff0000"]End If[/color]

 

 

Dvs. Då användaren skrivit något i tbSlutdatum görs en kontroll om slutdatumet är giltigt innan den uppdaterar startdatum. Om inte slutdatum är giltigt får användaren ett felmeddelande och inmatningsfätet töms(kan tas bort om du vill att användare ska se vad han skrivit.

 

[Mile]

Tack en gån till!

 

Sista koden fungerade OK.

Glömde säga att i förregående koden blev lite fel om man ska säga Att detta är fel. Nämligen om man väljer i tbForskjutning "0" då kommer felmeddelande:

Körfel nr '6'

Spill

 

sen öppnas koden och fellet pekar på:

steps= steps+1

 

Hur ska man åtgärda det' har du några förslag?

 

MVH

Mile

 

 

 

[Erki]

Självklart ska applikationen ha en felhantering så att användare blir uppmärsammad på felaktiga inmatningar så att han inte hamnar i Access felhantering.

 

tbforskjutning ska ha formatet tal och 0 decimaler (de två översta raderna på första fliken i egenskaper) Sedan skapar du en händelse för tbforskjutning Efter uppdatering

 

Private Sub tbforskjutning_AfterUpdate()

 

If Me.tbforskjutning < 1 Or Int(Me.tbforskjutning) <> Me.tbforskjutning Then

MsgBox ("Ogiltigt värde för förskjutning")

Me.tbforskjutning = 10

End If

End Sub

 

[inlägget ändrat 2007-03-19 15:39:36 av Erki]

[Mile]

Hej Erki!

 

Det sista koden tillåter inte 0 dagar i tbforskjutning men

hur ska man göra om man vill tillåta 0 dagar i tbforskjutning och inte hamna i felhantering.

 

MVH

MILE

 

 

[Zilver Ztream]

Detta tillåter noll om det var den koden du undrade över.

 

 

tbforskjutning_AfterUpdate True

 

Private Sub tbforskjutning_AfterUpdate(bolNoll As Boolean)
   If (Me.tbforskjutning < 1 Or Int(Me.tbforskjutning) <> Me.tbforskjutning) And bolNoll = False Then
       MsgBox ("Ogiltigt värde för förskjutning")
       Me.tbforskjutning = 10
   End If
End Sub

 

 

[Mile]

Hej!

 

Det fungerar inte.

Får felmeddelande:

 

Ett problem uppstod för VBA (Visual Basic for Applications) vid försök att komma åt en egenskap eller metod. Problemet kan vara något av följande:

En referens saknas.

Om du vill ha hjälp med att återställa saknade referenser, se Microsoft Knowledge Base-artikeln 283806.

Ett uttryck är felstavat.

Kontrollera att alla uttryck som används i händelseegenskaper är rättstavade.

En användardefinierad funktion har deklarerats som en sub- eller private-funktion i en modul.

Uttryck kan endast lösa en användardefinierad funktion om funktionen har deklarerats som något av följande:

En offentlig funktion i en modul

En offentlig eller privat funktion i en kodmodul i det aktuella formuläret eller rapporten

Säkerheten i Access har angetts till Medel eller Hög och Microsoft Jet 4.0 SP8-uppdateringen har inte installerats.

En senare version av Jet 4.0 måste installeras för att Access ska fungera korrekt när säkerheten har angetts till Medel eller Hög. Gå till Windows Update om du vill hämta den senaste versionen av Microsoft Jet.

 

 

 

MVH

Mile

 

[inlägget ändrat 2007-03-20 12:22:18 av Mile]

[inlägget ändrat 2007-03-20 12:22:34 av Mile]

[Mile]

Välkommen tillbaka Erki!

 

Jag behöver din hjälp angående din kod att beräkna antal dagar men utesluta "röda dagar"

 

Det sista koden tillåter inte 0 dagar i tbforskjutning men

hur ska man göra om man vill tillåta 0 dagar i tbforskjutning och inte hamna i felhantering.

 

DVS att jag vill att 0 dagar i tbforskjutning tillåts,

Snälla hjälp mig.

 

MVH

MILE

 

 

[Erki]

Hej!

 

Fungerar den kod du har fått fram till 18 mars 2007 12:49 om du satt förskjutningen till ett heltal 1 eller större men detta felmeddelande om du sätter förskjutningen till 0?

 

Det du skriver i förra inlägget om referenser tyder på ett helt annat fel. Du kanske kan klistra in hela den kod du har. Markera sedan koden och klicka på LOG-knappen så blir det inte så långt inlägg.

 

[Mile]

Hej Erki!

 

Det som jag skriver 20 mars är problem som jag fått efter att klistrat in kod från Zilver Ztream och detta kod har inte hjålp mig utan genererar felmeddelande och jag har återställt din kod från 18 mars.

 

Din Kod fungerar utan problem, men tillåter inte 0 värde i tbforskjutningoch jag får meddelande "Ogiltigt värde för tbforskjutning"

 

Snälla hjälp mig att fixa koden att den tillåter 0 värde i tbforskjutning.

 

Så här ser koden ut idag:

 

[log]Public Function ArbDag(Indatum) As Boolean 'Resultat False för Lördag, Söndag och helgdag Sant för övriga

Dim Veckodag, Year, A, B, C, D, E, F As Integer

Dim EasterDay As Date

Dim dbs As Database

Dim rst As DAO.Recordset

 

Set dbs = CurrentDb

Set rst = dbs.OpenRecordset("tblDatumUndantag", dbOpenTable)

rst.Index = "Datum"

rst.Seek "=", Indatum

 

If rst.NoMatch Then

rst.Close

 

Else

ArbDag = False ' En undantagsdag hittades

rst.Close

Exit Function

End If

 

Select Case DatePart("w", Indatum, vbMonday, vbFirstFourDays)

Case 6, 7

ArbDag = False ' Indatum är en lördag eller Söndag

Exit Function

Case Else ' Tillsvidare vet vi att det är en Må-Fr

 

If DatePart("m", Indatum, vbMonday, vbFirstFourDays) = 1 And (DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 1 Or DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 6) Then

ArbDag = False 'Indatum är Nyårsdag eller trettondag

Exit Function

End If

 

If DatePart("m", Indatum, vbMonday, vbFirstFourDays) = 5 And DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 1 Then

ArbDag = False 'Indatum är 1:a maj

Exit Function

End If

 

If DatePart("m", Indatum, vbMonday, vbFirstFourDays) = 12 And (DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 24 Or DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 25 Or DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 26 Or DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 31) Then

ArbDag = False 'Indatum är Julafton,Juldag, Annandag eller Nyårsafton

Exit Function

End If

 

If DatePart("m", Indatum, vbMonday, vbFirstFourDays) = 6 And (DatePart("d", Indatum, vbMonday, vbFirstFourDays) = 6) Then

ArbDag = False 'Indatum är nationaldagen 6 Juni

Exit Function

End If

 

' Hitta påskdag, Easterday

Year = DatePart("yyyy", Indatum, vbMonday, vbFirstFourDays)

 

 

m = 24 'Konstant giltig till 2199

N = 5 'Konstant giltig till 2099

A = Year Mod 19

B = Year Mod 4

C = Year Mod 7

D = (19 * A + m) Mod 30

E = (2 * B + 4 * C + 6 * D + N) Mod 7

F = 22 + D + E

If F = 57 Or (F = 56 And E = 6 And A > 10) Then F = F - 7

 

If F <= 31 Then

EasterDay = CDate(Year & "-" & "03-" & F)

 

Else

EasterDay = CDate(Year & "-" & "04-" & D + E - 9)

 

End If

'Hitta LångFredag AnnandagPåsk Kristihimmelsfärdsdag

If Indatum = EasterDay - 2 Or Indatum = EasterDay + 1 Or Indatum = EasterDay + 39 Then

ArbDag = False

Exit Function

End If

End Select

ArbDag = True 'Om Indatum inte är helgdag

End Function

 

Public Function WorkdayDiff(EndDate As Date, Period As Integer)

'Stop

Dim Startdate As Date

Dim Steps As Integer

Startdate = EndDate

Do

Startdate = Startdate - 1

If ArbDag(Startdate) Then

 

Steps = Steps + 1

End If

 

Loop Until Steps = Period

WorkdayDiff = Startdate

End Function[/log]

[inlägget ändrat 2007-04-14 17:13:09 av Mile]

[inlägget ändrat 2007-04-14 17:13:57 av Mile]