Hej i forummet....min første post her :-)
Jeg har et regneark hvor der er lidt VBA kode i.
Det er simpel kode tror jeg, men ikke desto mindre kan jeg ikke selv hitte hoved og hale i det!
Så jeg håber der er nogen her der kan hjælpe
I arket er der VBA kode der beregner helligdage. Det er lavet så jeg i cellerne A15, B15 og C15 skriver en eller flere datoer i formatet 14-08-2017
Beregningen returnerer tekst i A16, B16 og C16, hvor der enten kommer til at stå "Helligdag", "Hverdag" eller "Weekend".
Jeg har så yderligere lavet en betinget formattering i A16, B16 og C16, men den er lidt ligegyldig for nu :-)
Problemet er at hvis en af A15, B15 eller C15 er tomme, skriver koden stadig "Weekend" i den nedenstående celle, og den skal sådan set bare være tom.
Det er sikkert også vældig simpelt at rette, men jeg kan sgu' ikke
Så en mindre forklaring på hvad der er galt ville være dejligt, sammen med en rettet kode
Koden er her:
Option Explicit
Function UgeNr(d As Date)
'Returnerer ugenummer svarende til parameter-datoen
Dim t As Long
t = DateSerial(Year(d + (8 - Weekday(d)) Mod 7 - 3), 1, 1)
UgeNr = ((d - t - 3 + (Weekday(t) + 1) Mod 7)) \ 7 + 1
End Function
Function Påskedag(Aar As Integer) As Date
'Udregner påskedag for et givet årstal - Beregningsmetode ifl. Gauss
'Påskedag kan tidligst ligge den 22-3 og senest den 25-4
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim k As Integer
Dim p As Integer
Dim q As Integer
Dim m As Integer
Dim n As Integer
Dim intDay As Integer
Dim intMonth As Integer
k = Aar \ 100
p = (13 + 8 * k) \ 25
q = k \ 4
m = (15 - p + k - q) Mod 30
n = (4 + k - q) Mod 7
a = Aar Mod 19
b = Aar Mod 4
c = Aar Mod 7
d = (19 * a + m) Mod 30
e = (2 * b + 4 * c + 6 * d + n) Mod 7
If d + e <= 9 Then
intDay = 22 + d + e
intMonth = 3
ElseIf (d = 29) And (e = 6) Then
intDay = 19
intMonth = 4
ElseIf (d = 28) And (e = 6) And (a > 10) Then
intDay = 18
intMonth = 4
Else
intDay = d + e - 9
intMonth = 4
End If
Påskedag = DateSerial(Aar, intMonth, intDay)
End Function
Function DagsTypeNr(Dato As Date) As Integer
'Returnerer dagens typenr (se kommentarene til select-sætningen)
'Da de kirkelige helligedage - bortset fra juledag -
'ligger et bestemt antal dage fra påskedag, beregnes forskellen
'mellem parameterdatoen og påskedag i parameterdato-året
'I en kalender er det de "bevægelige" heligdage der er svære at styre.
'Det er typerne fra 1 til 8. Den periode de kan ligge i er fra den 19-3 til den 14-6
'Det er derfor ikke nødvendigt at lægge funktion ind uden for dette område
Dim PD As Date
Dim År As Integer
PD = Påskedag(Year(Dato))
År = Year(Dato)
Select Case Dato
Case PD - 3: DagsTypeNr = 1 ' 1. Skærtorsdag
Case PD - 2: DagsTypeNr = 2 ' 2. Langfredag
Case PD + 0: DagsTypeNr = 3 ' 3. Påskedag
Case PD + 1: DagsTypeNr = 4 ' 4. 2 Påskedag
Case PD + 26: DagsTypeNr = 5 ' 5. Bededag
Case PD + 39: DagsTypeNr = 6 ' 6. Kristi himmelfart
Case PD + 49: DagsTypeNr = 7 ' 7. Pinsedag
Case PD + 50: DagsTypeNr = 8 ' 8. 2 Pinsedag
Case DateSerial(År, 1, 1): DagsTypeNr = 9 ' 9. Nytårsdag
Case DateSerial(År, 5, 1): DagsTypeNr = 10 '10. 1 maj
Case DateSerial(År, 6, 5): DagsTypeNr = 11 '11. Grundlovsdag
Case DateSerial(År, 12, 24): DagsTypeNr = 12 '12. Juleaften
Case DateSerial(År, 12, 25): DagsTypeNr = 13 '13. Juledag
Case DateSerial(År, 12, 26): DagsTypeNr = 14 '14. 2. Juledag
Case DateSerial(År, 12, 31): DagsTypeNr = 15 '15. Nytårsaften
Case Else
Select Case Weekday(Dato, vbMonday)
Case 6: DagsTypeNr = 21
Case 7: DagsTypeNr = 22
Case Else: DagsTypeNr = 0
End Select
End Select
End Function
Function DagsTypeTekst(Dato As Date) As String
'Returnerer datotypen (se selectsætningen)
'Da de kirkelige helligedage - bortset fra juledag -
'ligger et bestemt antal dage fra påskedag, beregnes forskellen
'mellem parameterdatoen og påskedag i parameterdato-året
Dim PD As Date
Dim År As Integer
PD = Påskedag(Year(Dato))
År = Year(Dato)
Select Case Dato
Case PD - 49: DagsTypeTekst = "Fastelavn"
Case PD - 3: DagsTypeTekst = "Skærtorsdag"
Case PD - 2: DagsTypeTekst = "Langfredag"
Case PD + 0: DagsTypeTekst = "Påskedag"
Case PD + 1: DagsTypeTekst = "2. Påskedag"
Case PD + 26: DagsTypeTekst = "Bededag"
Case PD + 39: DagsTypeTekst = "Kristi himmelfart"
Case PD + 49: DagsTypeTekst = "Pinsedag"
Case PD + 50: DagsTypeTekst = "2. Pinsedag"
Case DateSerial(År, 1, 1): DagsTypeTekst = "Nytårsdag"
Case DateSerial(År, 5, 1): DagsTypeTekst = "1. maj"
Case DateSerial(År, 6, 5): DagsTypeTekst = "Grundlovsdag"
Case DateSerial(År, 12, 24): DagsTypeTekst = "Juleaften"
Case DateSerial(År, 12, 25): DagsTypeTekst = "Juledag"
Case DateSerial(År, 12, 26): DagsTypeTekst = "2. Juledag"
Case DateSerial(År, 12, 31): DagsTypeTekst = "Nytårsaften"
Case Else
Select Case Weekday(Dato, vbMonday)
Case 6: DagsTypeTekst = "Weekend"
Case 7: DagsTypeTekst = "Weekend"
Case Else: DagsTypeTekst = "Hverdag"
End Select
End Select
End Function
På forhånd tak for hjælpen
Mvh.
Thomas