Opvullen Array

[Robvanlooy]

Beste,

ik staar me al een hele week blind op een ARRAY die niet correct opgevuld wordt.
Het gaat met name over volgend probleem.

In tabblad DATA, zal een eindgebruiker een reeks gegevens uit een data dump plakken.
hieruit zal bij het drukken op een knop een loop doorlopen worden net zolang dat een bepaalde regel leeg is "dit is het signaal dat de datadump ten einde is"
hieronder een voorbeeld van de datadump ("tabblad DATA")


in principe zou er verwacht worden dat de regels met artikelnummer 042001 met THT 14/03/2021 samengenomen worden in een regel.
echter komt onderstaande eruit


zoals je ziet neemt hij telt hij de aantallen samen van artikel 042001 met THT 14/03/2021 maar komt deze er alsnog 2 keer in.
ik vermoed dat ik ergens uit het lusje moet springen maar zie het echt niet.

hieronder de code "dit is enkel het stukje met betrekking tot het doorlopen van het DATA tablad en het opvullen van de ARRAY.

teller = 2
aantalregels = 0

Do Until IsEmpty(Sheets("data").Range("A" & teller).Value) = True

aantalregels = aantalregels + 1​

huidigartikel = Sheets("data").Range("E" & teller).Value​

huidigaantal = Sheets("data").Range("H" & teller).Value​

huidigeTHT = Sheets("data").Range("i" & teller).Value​

For tabelteller = 1 To 100

If huidigartikel = Tellijst(tabelteller, 1) And huidigeTHT = Tellijst(tabelteller, 3) Then​

Tellijst(tabelteller, 2) = Tellijst(tabelteller, 2) + huidigaantal​

Else​

Tellijst(aantalregels, 1) = huidigartikel​

Tellijst(aantalregels, 2) = huidigaantal​

Tellijst(aantalregels, 3) = huidigeTHT​

End If​

Next tabelteller
'tabel verder doorlopen op dubbele artikels
teller = teller + 1
Loop

 

[alphamax]

Met een voorbeeldbestandje wordt je sneller en beter geholpen.
Helpers houden niet van overtypen.

 

[Robvanlooy]

sorry, nu met bijlage

 

[snb]

Gebruik een draaitabel.

 

[VenA]

Zorg er eerst voor dat de data op de juiste manier in jouw 'tabel' komt. Bijna alles staat als tekst en Excel kan daar zonder kunstgrepen niet mee rekenen.

 

[Robvanlooy]

Gebruik een draaitabel.

Ik wil geen draaitabel gebruiken omdat dit bestand door mensen gebruikt gaat worden zonder kennis van Excel.
Het zou dus met een druk op een knop moeten lukken

 

[Robvanlooy]

Zorg er eerst voor dat de data op de juiste manier in jouw 'tabel' komt. Bijna alles staat als tekst en Excel kan daar zonder kunstgrepen niet mee rekenen.

Dat was ook mijn eerste gedacht, maar je zou in principe toch ook tekst met elkaar moeten kunnen vergelijken?

 

[snb]

Een draaitabel hoeft maar 1 keer gemaakt te worden (niet door de gebruiker). De 'verversing' is inderdaad slechts 1 druk op de knop.

 

[Robvanlooy]

Een draaitabel hoeft maar 1 keer gemaakt te worden (niet door de gebruiker). De 'verversing' is inderdaad slechts 1 druk op de knop.

een draaitabel bied geen oplossing voor mijn probleem, er is een bepaalde layout die gebruikt moet worden, alsook worden er meerdere datafiles aangesproken om tot het einddoel te komen.

 

[snb]

Ben je wel op de hoogte van draaitabellen ?

 

[Robvanlooy]

Ben je wel op de hoogte van draaitabellen ?

Ik wel ja, maar de eindgebruikers niet(zoals initieel aangegeven)
En bijkomend is de vraag niet hoe ik dit anders kan oplossen dan mijn benadering, maar meer waar zit de fout in mijn benadering.
Maar toch bedankt voor uw mening.

 

[snb]

Svp niet citeren/quoten ! Gebruik de goede reaktieknop.

 

[VenA]

Gebruik geen samengevoegde cellen. Maak gebruik van echte tabellen. Hoe je wilt filteren op 'Picker', 'ordernummer' en 'klantnummer' is mij niet geheel duidelijk. Je verwijst nu naar de tab 'DATA' dit heb ik maar zo gehouden.

Sub VenA()
  Dim j As Long, a(3), b(), ar, ar1, ar2, d
  ar = Sheets("DATA").ListObjects(1).DataBodyRange
  ar2 = Sheets("Artikelen").ListObjects(1).DataBodyRange
  Set d = CreateObject("Scripting.Dictionary")
  With Sheets("TELLIJST")
    ar1 = .Range("B3:B5")
    For j = 1 To UBound(ar)
      If ar(j, 10) = ar1(1, 1) And ar(j, 2) = ar1(2, 1) And ar(j, 3) = ar1(3, 1) Then
        c00 = ar(j, 5) & ar(j, 9)
        y = Application.Match(ar(j, 5), Application.Index(ar2, 0, 1), 0)
        a(0) = "'" & ar(j, 5)
        a(1) = IIf(IsNumeric(y), ar2(y, 2), "Niet gevonden")
        a(2) = ar(j, 8)
        a(3) = Format(ar(j, 9), "mm-dd-yyyy")
        If Not d.Exists(c00) Then
          d(c00) = a
         Else
          b = d(c00)
          b(2) = b(2) + a(2)
          d(c00) = b
        End If
      End If
    Next j
    With .ListObjects(1)
      If .ListRows.Count Then .DataBodyRange.Delete
      If d.Count Then .ListRows.Add.Range.Resize(d.Count, 4) = Application.Index(d.items, 0, 0)
    End With
  End With
End Sub

 

[HSV]

Of:

Sub hsv()
Dim sv, sv2, sv3, shTel As Range
sv = Sheets("data").Cells(1).CurrentRegion.Offset(1).Resize(, 26)
sv2 = Sheets("artikelen").Cells(1).CurrentRegion
Set shTel = Sheets("tellijst").Cells(8, 1)
 shTel.Resize(UBound(sv) - 1, 7).ClearContents
 shTel.Resize(UBound(sv) - 1, 1).Name = "b"
 [b].NumberFormat = "@"
 shTel.Resize(UBound(sv), 4) = Application.Index(sv, Evaluate("row(1:" & UBound(sv) & ")"), Array(5, 26, 8, 9))
 [b].Offset(, 3).Replace "??:??:??", ""
 sv3 = shTel.Resize(UBound(sv) - 1, 1)
   With Application
     shTel.Resize(UBound(sv) - 1).Offset(, 1) = .IfError(.Index(sv2, .Match(sv3, .Index(sv2, , 1), 0), 2), "niet gevonden")
     shTel.Offset(, 2).Resize(UBound(sv) - 1) = [if(row(b),sumifs(offset(b,,2),b,b,offset(b,,3),offset(b,,3)))]
     shTel.Resize(UBound(sv) - 1, 4).RemoveDuplicates Array(1, 2, 3, 4), xlYes
   End With
End Sub

 

[snb]

Een typisch database-geval.

Sub M_snb_002()
  Blad1.UsedRange.Offset(7).ClearContents
  c00 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0"""
    
  With CreateObject("ADODB.recordset")
    .Open "select [DATA$].Artikelnummer,  [Artikelen$].Omschrijving, [DATA$].Aantal, [DATA$].THT from [DATA$] , [Artikelen$] where [DATA$].Artikelnummer = [Artikelen$].Artikelnummer", c00
    Blad1.Cells(8, 1).CopyFromRecordset .DataSource
  End With
End Sub