Aantallen tellen op bepaalde datum

[michel241165]

Beste forumleden,

Ik wil het aantal dozen tellen welke wij op een bepaalde datum versturen gesplitst per projectnummer. De gegevens worden in tabblad "Data" verzameld.

In bijgaand voorbeeld Excel:

Tabblad "Paklijst":
Deze moet automatisch gegeneerd worden. Wanneer ik in cel B2 een datum selecteer wil ik in de rijen er onder zien het aantal dozen van een bepaald project worden verstuurd.
In het voorbeeldbestand heb ik als datum 21-8-2020 genomen. Er zijn op die dag 11 pallets met totaal 224 dozen verdeeld over 107 project verstuurd. Deze heb ik nu al vaste gegevens gezet in het overzicht als voorbeeld. Kan ik dit automatisch laten inlezen als ik een andere datum selecteer?
Onderaan in kolom B staat een som van het aantal dozen. Dit is niet perse nodig, maar zou leuk zijn.

Tabblad Data:
In deze lijst staan alle gegenereerde gegevens per dag. Iedere rij is één pallet met dozen. Dit is niet altijd hetzelfde aantal, maar maximaal 24 per pallet.
Kolom A: De dag dat deze rij is gegenereerd.
Kolom B t/m Y: De gescande projectnummer (=dozen) op een pallet.

Tabblad "Datums":
Alleen een hulplijst voor cel B1 op tabblad "Paklijst".

Kan iemand mij helpen?

 

[JEC.]

Heb je office 365?

 

[JEC.]

Optie met een macro.
Kies een datum en haal data op door te drukken op de knop

Sub jveer()
 With CreateObject("Scripting.Dictionary")
 jv = Sheets("Data").Cells(1).CurrentRegion
    For i = 2 To UBound(jv)
      For ii = 2 To UBound(jv, 2)
        If jv(i, 1) = CDate(Sheets(1).Range("B1")) And jv(i, ii) <> "" Then
          If Not .Exists(jv(i, ii)) Then
            .Add jv(i, ii), Array(jv(i, ii), 1)
          Else
             a = .Item(jv(i, ii))
             a(1) = a(1) + 1
            .Item(jv(i, ii)) = a
          End If
        End If
       Next
     Next
     If .Count = 0 Then Exit Sub
     Sheets(1).Cells(4, 1).CurrentRegion.Offset(1).ClearContents
     Sheets(1).Cells(4, 1).Resize(.Count, 2) = Application.Index(.items, 0, 0)
 End With
End Sub

 

[michel241165]

Ja

 

[michel241165]

Ik bedoel ja, ik heb office 365

 

[AlexCEL]

Voor dit soort bewerking met grote datasets kan je Power Query gebruiken. Tabel inladen, paar bewerkingen op los laten (waaronder er 1 lijst van maken), daarna inladen in gegevensmodel, en vervolgens een draaitabel van maken met datumfilter. Dan krijg je precies je gewenste output, zonder vertragende formules. Plus: blad datums is overbodig geworden.

 

[HSV]

De macro bijgeschaafd.

Sub hsv()
 With CreateObject("Scripting.Dictionary")
 sv = Sheets("Data").Cells(1).CurrentRegion
    For i = 2 To UBound(sv)
      For j = 2 To UBound(sv, 2)
        If sv(i, 1) = Sheets(1).Range("b1") And sv(i, j) <> "" Then
            .Item(sv(i, j)) = .Item(sv(i, j)) + 1
        End If
       Next
     Next
    Sheets(1).Cells(4, 1).CurrentRegion.Offset(1).ClearContents
   If .Count > 0 Then Sheets(1).Cells(4, 1).Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
 End With
End Sub

voor iets meer snelheid...

Sub hsv()
 With CreateObject("Scripting.Dictionary")
 sv = Sheets("Data").Cells(1).CurrentRegion
  b1 = Sheets(1).Range("b1")
    For i = 2 To UBound(sv)
      For j = 2 To UBound(sv, 2)
       If sv(i, j) <> "" Then
         If sv(i, 1) = b1 Then .Item(sv(i, j)) = .Item(sv(i, j)) + 1
       End If
      Next
     Next
    Sheets(1).Cells(4, 5).CurrentRegion.Offset(1).ClearContents
   If .Count > 0 Then Sheets(1).Cells(4, 5).Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
 End With
End Sub

 

[michel241165]

Voor dit soort bewerking met grote datasets kan je Power Query gebruiken. Tabel inladen, paar bewerkingen op los laten (waaronder er 1 lijst van maken), daarna inladen in gegevensmodel, en vervolgens een draaitabel van maken met datumfilter. Dan krijg je precies je gewenste output, zonder vertragende formules. Plus: blad datums is overbodig geworden.

AlexCEL, Dank je voor de input. Ik ben met jouw voorbeeldbestand verder gegaan en het werkend gekregen. Nog wel met kopiëren uit jouw voorbeeld, maar ik heb er weer veel van geleerd.

@JVeer en HSV: Ook jullie bedankt. Ook deze oplossing was werkbaar en kan ik als back-up gebruiken. Deze heb ik alleen gekopieerd n geplakt. Hiervoor heb ik te weinig kennis van VBA.