Navigation

   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

Navigation

Simpelt VBA hjælp tror jeg