Simpelt VBA hjælp tror jeg
Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=3124
Udskrevet den: 03.Maj.2024 kl. 03:24
Emne: Simpelt VBA hjælp tror jeg
Besked fra: mureren
Emne: Simpelt VBA hjælp tror jeg
Posteringsdato: 14.Aug.2017 kl. 11:32
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
|
Svar:
Besked fra: Bjarnehansen
Posteringsdato: 14.Aug.2017 kl. 21:41
prøv at /topic662.html - upload dit ark så skulle vi nok kunne finde en løsning..
------------- Husk, at trykke på [Tak], hvis du kan lide et indlæg. Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag. Med venlig hilsen - Bjarne Hansen - Microsoft 365 DK
|
Besked fra: mureren
Posteringsdato: 14.Aug.2017 kl. 22:01
Værsgo'
Der er fjernet nogle ark og oplysninger af hensyn til personlige- og/eller firmaoplysninger. Håber det er ok, og at jeg kan kopiere en evt. fungerende kode over i det originale regneark. uploads/2023/AT_master_ver_2017-08-14_21-59-26._03_TS_-_Kopi_2017-08-14_21-59-26.xlsm" rel="nofollow - uploads/2023/AT_master_ver_2017-08-14_21-59-26._03_TS_-_Kopi_2017-08-14_21-59-26.xlsm
|
Besked fra: mureren
Posteringsdato: 21.Aug.2017 kl. 21:28
Var det mon sværere end jeg troede?
|
Besked fra: EXCELGAARD
Posteringsdato: 24.Aug.2017 kl. 09:41
Du behøver ikke engang VBA til det
I A16 skriver du blot
=HVIS(A15="";"";DagsTypeTekst(A15)) | ...og, på samme måde, i de to øvrige celler.
------------- Husk, at trykke på [Tak], hvis du kan lide et indlæg. Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.
|
Besked fra: mureren
Posteringsdato: 24.Aug.2017 kl. 14:22
EXCELGAARD skrev:
Du behøver ikke engang VBA til det
I A16 skriver du blot
=HVIS(A15="";"";DagsTypeTekst(A15)) | ...og, på samme måde, i de to øvrige celler.
|
Smukt smukt, og igen så simpelt! Det er til at tude over hvor lidt jeg kan af det her Excel Well, practise makes perfect, og jeg forstod faktisk formlen bare ved at kigge lidt på den, det er fremskridt for mig
|
Besked fra: EXCELGAARD
Posteringsdato: 24.Aug.2017 kl. 18:29
Husk, at markere svaret som 'Accepteret svar', hvis du kan bruge det...
------------- Husk, at trykke på [Tak], hvis du kan lide et indlæg. Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.
|
|