Opvullen Array

Status
Niet open voor verdere reacties.
R

Robvanlooy

Gebruiker
Lid geworden
18 feb 2021
Berichten
6
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")
datadump.png

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
uitkomst.png

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
 
Met een voorbeeldbestandje wordt je sneller en beter geholpen.
Helpers houden niet van overtypen.
 
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.
 
VenA zei:
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.
Klik om te vergroten...

Dat was ook mijn eerste gedacht, maar je zou in principe toch ook tekst met elkaar moeten kunnen vergelijken?
 
Een draaitabel hoeft maar 1 keer gemaakt te worden (niet door de gebruiker). De 'verversing' is inderdaad slechts 1 druk op de knop.
 

Bijlagen

  • __tellijst.xlsm
    93,1 KB · Weergaven: 18
Laatst bewerkt:
snb zei:
Een draaitabel hoeft maar 1 keer gemaakt te worden (niet door de gebruiker). De 'verversing' is inderdaad slechts 1 druk op de knop.
Klik om te vergroten...

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.
 
Ben je wel op de hoogte van draaitabellen ?
 
snb zei:
Ben je wel op de hoogte van draaitabellen ?
Klik om te vergroten...


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.
 
Svp niet citeren/quoten ! Gebruik de goede reaktieknop.
 
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.

Code: 
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
 

Bijlagen

  • tellijst.xlsb
    85,2 KB · Weergaven: 18
Of:
Code: 
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
 

Bijlagen

  • tellijst.xlsb
    87,5 KB · Weergaven: 41
Een typisch database-geval.

Code: 
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
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan