2-jaars kalender aanpassen

Status
Niet open voor verdere reacties.
G

gast0666

Gebruiker
Lid geworden
21 jun 2019
Berichten
90
Beste forumleden,

Ik heb een 2-jaarskalender die ik aan wil passen, maar door mijn geringe kennis van VBA kom ik daar niet uit.
Bijgaand heb ik de kalender gevoegd en de macro toegevoegd.
Een 2-jaars kalender omdat werkzaamheden wel overlopen naar et tweede jaar.

Mijn wensen zijn:
Nadat het nieuwe jaar is aangebroken moeten de omschrijvingen in het tweede jaar worden verplaatst naar het eerste jaar.
Door het schrikkeljaar wordt dat bemoeilijkt.
Omdat de gebruiker in kan grijpen op de werkdagen (ja/nee), kopieer ik de formule later weer naar de juiste cellen (kolom E).

Is het wel mogelijk om dat in een macro te plaatsen?

mvg,

Code: 
ActiveSheet.Unprotect
Range("G5:J369").ClearContents
Range("E4").Select
Application.CutCopyMode = False
Selection.Copy
Range ("E5:E734")
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
 

Bijlagen

  • kalender.xlsx
    76,6 KB · Weergaven: 48
Laatst bewerkt door een moderator:
zo
 

Bijlagen

  • kalender.xlsb
    61 KB · Weergaven: 48
Beste Cow18,

Dank voor je reactie.

Maar mijn vraag is of het mogelijk is dat de aantekeningen (kolom G t/m M) in het tweede jaar opgeschoven kunnen worden als er een nieuw jaar wordt aangemaakt.
Dus als het huidige jaar 2020 is en de aantekeningen in het jaar 2021 zijn aangemaakt, dat die dus naar het eerste jaar worden verschoven.

Simpel gezegd: ik kan het eerste jaar dus ook verwijderen en er daarna weer een jaar onder aan vast maken.

mvg,
 
Laatst bewerkt door een moderator:
ja, dat is eenvoudig mogelijk.
Vanavond, tenzij iemand anders ...
 
Best Cow18,

Dank voor je reactie.
Ik wacht met spanning af en ben erg benieuwd.

mvg,
 
Laatst bewerkt door een moderator:
zo
 

Bijlagen

  • kalender.xlsb
    71,7 KB · Weergaven: 46
Beste Cow18,

Dank voor je reactie, maar dat is helaas niet wat ik bedoel.
In de kolommen G t/m M worden werkzaamheden, uren en kilometerstanden ingevoerd.
Wanneer er een nieuw jaar is aangebroken veranderd de kalender door cel B2.
Maar de werkzaamheden, uren en kilometerstanden blijven in de cellen staan.
De gegevens van het 2e jaar (in dit geval 2021) wil ik graag naar het 1e jaar brengen.
Het 2e jaar wordt dan weer schoon.

Simpel gezegd zou ik het eerst jaar (2020) kunnen verwijderen zodat de gegevens van het 2e jaar (2021) weer op de juiste plaats staan.
En daarna weer het jaar 2021 met een 2e jaar aanvullen.
Het schrikkeljaar maakt het lastig.

Wil je er nog eens naar kijken?

mvg,
 
Laatst bewerkt door een moderator:
heel lichte variant, zo werkt het toch, ik verander tegelijk B2, schrap de eerste 365 of 366 dagen en voeg er dan toe tot er 731 rijen in de tabel staan
 

Bijlagen

  • kalender.xlsb
    73,6 KB · Weergaven: 51
Beste Cow18,

Ik kan het niet goed volgen.
In kolom G plaats ik opmerkingen namens de administratie. Bijvoorbeeld facturen verzenden.
In kolom H de administratieve uren.
In kolom I de praktische werkzaamheden, bijvoorbeeld reinigingswerkzaamheden. En in kolom J de praktische uren.

Jij hebt in kolom G ook datums staan. Ik begrijp niet wat je daar mee bedoelt.

mvg,
 
Laatst bewerkt door een moderator:
G en I mogen leeggemaakt worden.
G was aanvankelijk om de formule van F te vereenvoudigen, maar is achteraf niet meer geschrapt geworden.
 
Beste Cow18,

Dank voor de toelichting,

Ik begrijp nog niet wat je bedoelt met "schrap de eerste 365 of 366 dagen en voeg er dan toe tot er 731 rijen in de tabel staan toe".
Hoe vertaal ik dat in de macro?

mvg,
 
Laatst bewerkt door een moderator:
eigenlijk was dit enkel een verwijzing naar wat de macro intern uitricht, zie hieronder
- de eerste rode lijn veegt het huidige jaar jaar, dus het eerste van de 2 jaren
- het volgende rode blok vult de tabel aan tot 731 lijnen, dat is afhankelijk van of 1 van beide jaren een schrikkeljaar is correct, in het andere geval zit daar nog de 1e januari van het derde jaar bij.

Dus eigenlijk hoef je niets te doen, enkel begrijpen wat er op de achtergrond gebeurt.
Code: 
Sub VolgendJaar()
   With Sheets("blad1")
      Set tbl = .ListObjects("tabel2")           'tabel2 in blad1
      arr = Application.Transpose(tbl.DataBodyRange.Columns(1))   'lees 1e kolom van tabel naar array
      nieuw = DateSerial(.Range("B2").Value + 1, 1, 1) 'nieuwe datum = 1  januari volgend jaar
      r = Application.Match(CLng(nieuw), arr, 0)   'op hoeveelste plaats staat 1e datum + 1 jaar ?

      If IsNumeric(r) Then                       'is numeriek, dus die datum bestaat
         .Range("B2").Value = Year(nieuw) 'schrijf nieuwe jaar in B2
         Set c = tbl.DataBodyRange.Cells(r, 1)   'dat is de cel van die datum
         c.Value = c.Value                       'vervang formule door datum
        [COLOR="#FF0000"] If r > 2 Then c.Offset(-r + 1).Resize(r - 1).EntireRow.Delete   'voorliggend jaar verwijderen
       [/COLOR]  aantal = tbl.ListRows.Count             'huidig aantal rijen, dus aantal dagen
         [COLOR="#FF0000"]If aantal < 731 Then                    'aantal dagen in 2 jaar (+1 voor eventueel schrikkeljaar)
            With tbl.ListRows.Add.Range.Cells(1)   'nieuwe tabelrij toevoegen
               .Offset(-1).Copy .Resize(731 - aantal)   'zoveel nieuwe dagen toevoegen
            End With
         End If[/COLOR]
         Application.Goto .Range("A1")

      Else
         MsgBox "zelfde dag volgend jaar niet gevonden " & Format(nieuw, "ddd dd-mm-yyyy")
      End If

   End With
End Sub
 
Laatst bewerkt:
Beste Cow18,

Veel dank voor de macro.
Had ik als beginneling nooit kunnen maken.
Ik ga het overnemen.
Moet ik het blad en de tabel ook wijzigen?

mvg,
 
Laatst bewerkt door een moderator:
Liefst anders werkt het niet in je echte bestand.
Maar gelukkig, op het eerste zicht slechts 2 keer, in die eerste regels
 
Beste cow18,

Ik heb de macro getest, maar weet niet of het werkt.
We zitten immers in het jaar 2020.
Wat ik wel mis is dat de opmerkingen in het 2e blok (jaar 2021), niet naar het eerste blok worden verplaatst.
Dat zal het meest pittig zijn, denk ik.
Zou je daar nog naar willen kijken?

mvg,
 
Laatst bewerkt door een moderator:
Waarom niet ?

In B2: 2021
In A4: 01-01-2020

Code: 
Sub M_snb()
    sn = Range("A2:B4")
    Blad1.ListObjects(1).ListRows(1).Range.Resize(DateSerial(Year(sn(3, 1)), 12, 31) - sn(3, 1) + 1).Delete
    Blad1.Cells(4, 1).Resize(DateSerial(sn(1, 2) + 1, 12, 31) - DateSerial(sn(1, 2), 1, 0)) = [index(text(date(B2,1,row(1:731)),"yyyy-mm-dd"),)]
End Sub
 
Beste snb,

Dank voor je bijdrage.
Ik ga er vandaag mee aan de slag.

mvg,
 
Laatst bewerkt door een moderator:
Beste snb,

Het is niet gelukt om mijn wens in vervulling te laten gaan :mad:
Ik heb de code volledig overgenomen.
De gegevens van het tweede jaar naar het eerste jaar te verplaatsen lukt nog niet. (kolom G t/m M).
De code is ook zo nietszeggend voor mij waardoor ik niet kan zeggen wat er eventueel veranderd moet worden.
Wat kan ik doen?

mvg,
 
Laatst bewerkt door een moderator:
Je hebt toch hopelijk alleen mijn code gebruikt en geen andere ?
 
Beste snb,

Ik heb deze code gebruikt:
Code: 
 Sub M_snb()
 With Blad8
    sn = Range("A2:B4")
    Blad8.ListObjects(1).ListRows(1).Range.Resize(DateSerial(Year(sn(3, 1)), 12, 31) - sn(3, 1) + 1).Delete
    Blad8.Cells(4, 1).Resize(DateSerial(sn(1, 2) + 1, 12, 31) - DateSerial(sn(1, 2), 1, 0)) = [index(text(date(B2,1,row(1:731)),"yyyy-mm-dd"),)]
End Sub

Blad 1 heb ik gewijzigd in Blad 8 (is het werkblad bij mij).
Mijn wens is om de gegevens van het tweede jaar naar het eerste jaar te brengen ivm met overloop van werk.

mvg,
 
Laatst bewerkt door een moderator:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan