Week/Maand gegevens wegschrijven naar bijbehorende week/maand tabbladen

[omersade]

Beste Mensen AUB Help,
Ik wil graag met macro weekgegevens willen wegschrijven naar (tabbladen WEEK en MAAND) aan de hand van de weeknummers.

 

[VenA]

Maak er eerst een tabel van. (Blad Database) Vervolgens kan je dmv draaitabellen jouw overzichten maken.

Sub VenA()
ReDim ar1(3, 0)
  For Each it In Sheets("INVOER").Columns(25).SpecialCells(2).Areas
    ar = it.CurrentRegion
    For j = 4 To UBound(ar) - 1
      For jj = 2 To UBound(ar, 2) - 3 Step 4
        If Len(ar(j, 1)) > 1 Then
          ar1(0, t) = ar(j, 1)
          ar1(1, t) = CDbl(ar(3, jj))
          ar1(2, t) = ar(j, jj + 3) * 24
          ar1(3, t) = Application.WeekNum(CDbl(ar(3, jj)), 21)
          t = t + 1
          ReDim Preserve ar1(3, t)
        End If
      Next jj
    Next j
  Next it
  
  With Sheets("Database").ListObjects(1)
    If .ListRows.Count Then .DataBodyRange.Delete
    .ListRows.Add.Range.Resize(t, 4) = Application.Transpose(ar1)
  End With
  ThisWorkbook.RefreshAll
End Sub

 

[omersade]

Weekformulier gegevens wekelijks worden weggeschreven naar tabblad WEEK.

Beste VenA,
Allereerst heel erg bedankt voor je moeite die je hebt genomen. Ik zag dat je veel tijd heb ingestoken, dat waardeer ik enorm.
Ik denk dat ik zelf ingewikkeld heb gemaakt bovendien, heb ik niet goed uitleg gegeven wat mijn bedoelingen zijn. Excuus hierover.
...
Mijn bedoeling is:
Ik heb een week formulier die ik zelf de uren invullen.
Bij tabblad "INVOER" Cel B3 vul ik zelf de datum in.
Aan de hand van de Cel B3 word de weeknummer weergegeven in Cel A1.
Eind van de week wil ik via Macro, de weekgegevens van de Cellen AE4 t/m AE14 willekeurig wegschrijven naar tabblad "WEEK" en meteen ook de formulier leeg komen te staan voor volgende week.

Ik hoop dat ik deze keer beter uitgelegd hebt.
ooh ja, trouwens je bestand heb ik bestudeerd, ik kan de filters op "DATABASE" niet kunnen bewerken omdat ik een Office 2007 versie hebt.
Nieuw voorbeeldbestand bijgevoegd.

Bij voorbaat heel erg BEDANKT

 

[VenA]

Dan zou ik alsnog de gegevens wegschrijven naar een tabel omdat het je veel meer flexibiliteit geeft. Het voorbeeldje heb ik gemaakt in XL-2007 dus zou bij jou ook moeten werken. 31-12-2019 valt is een dinsdag en 06-01-2020 valt in week 2.

Sub VenA()
  ReDim ar1(3, 0)
    With Sheets("INVOER").Cells(1).CurrentRegion
      ar = .Value
      .Offset(2).SpecialCells(2, 1).ClearContents
    End With
    For j = 4 To UBound(ar) - 1
      For jj = 2 To UBound(ar, 2) - 3 Step 4
        If Len(ar(j, 1)) > 1 Then
          ar1(0, t) = ar(j, 1)
          ar1(1, t) = CDbl(ar(3, jj))
          ar1(2, t) = ar(j, jj + 3) * 24
          ar1(3, t) = DatePart("ww", ar(3, jj) - Weekday(ar(3, jj), 2) + 4, 2, 2)
          t = t + 1
          ReDim Preserve ar1(3, t)
        End If
      Next jj
    Next j
  
  Sheets("Database").ListObjects(1).ListRows.Add.Range.Resize(t, 4) = Application.Transpose(ar1)
  ThisWorkbook.RefreshAll
End Sub

 

[omersade]

Weekformulier gegevens wekelijks worden weggeschreven naar tabblad WEEK.

Beste VenA,
Dit is wat ik zocht. Geweldig!

Bedankt voor je hulp.

 

[snb]

In plaats van:

=D4-B4-SUM(IF(AND(B4<=$B$18;D4>=$D$18);$D$18-$B$18;0);IF(AND(B4<=$B$19;D4>=$D$19);$D$19-$B$19;0);IF(AND(B4<=$B$20;D4>=$D$20);$D$20-$B$20;0))

=D4-B4-CHOOSE(IFERROR(MATCH(D4;$D$18:$D$20;1);0)+1;0;1;3;4)/96