Overzicht produkten per persoon

[jefkeh]

Hoi,
Ik had graag de produkten per persoon bij elkaar.
In blad1 heb ik een lijst met produkten + aantal + persoon.
Nu zou ik graag op blad2 een overzicht maken van personen met de produkten die bij die persoon horen, zodat ik dit kan uitprinten.
Dat zal met draaitabellen gemakkelijk gaan, maar ik had het graag anders.
vb: jan prod1
prod3

jef prod5
prod2 enz..
Liefst een macro, of formule als dit gemakkelijker is.
Moest er al iets dergelijk op het forum staan, graag een tip dan probeer ik zelf eerst wel.

Alvast bedankt.

 

[jkpieterse]

Ik snap het niet, wat jij beschrijft lijkt erg veel op een draaitabel met zowel Leveranciers als Dag1 in het rijveld?

 

[MarcelBeug]

Kun je iets specifieker zijn hoe dat blad2 er dan uit zou moeten zien? Hij is nu leeg namelijk...

Misschien begrijpen we dan ook wat beter waarom een draaitabel niet volstaat.
Of waarom je niet gewoon een kopietje maakt van Blad1 waarin je sorteert op leverancier en product.
Of waarom je niet gewoon Blad1 sorteert op leverancier en product.

 

[jefkeh]

In mijn bestand op blad1 heb ik een vb staan van hoe ik het graag had op blad2.
Da sorteren van blad1 zou ook kunnen, maar in het bestand waar ik het ga toepassen staan meer gegevens bij.
En die heb ik nie allemaal nodig op dat moment.
Hopelijk is het nu wat duidelijker.
Alvast bedankt voor het snelle reageren.

 

[HSV]

Wat een wensen.

Sub hsv()
Dim sn, i As Long, a, b(3)
sn = Sheets("Blad1").Cells(1).CurrentRegion
With CreateObject("scripting.dictionary")
  For i = 2 To UBound(sn)
     a = .Item(sn(i, 3) & sn(i, 1))
     If IsEmpty(a) Then a = b
        a(0) = sn(i, 3)
        a(1) = a(1) & sn(i, 1)
        a(2) = a(2) & sn(i, 2)
     .Item(sn(i, 3) & sn(i, 1)) = a
    Next i
 Cells(1, 14).Resize(.Count, 4) = Application.Index(.items, 0, 0)
 Cells(1, 14).Sort [n1], 2, , , , , , xlNo
    sn = Sheets("Blad1").Cells(1, 14).CurrentRegion
     For i = UBound(sn) To 2 Step -1
       If sn(i, 1) = sn(i - 1, 1) Then sn(i, 1) = ""
     Next i
    Cells(1, 14).Resize(UBound(sn)) = sn
    Columns(15).Insert
 End With
End Sub

 

[jefkeh]

Sorry dat ik veel vraag, en ik krijg het niet voor elkaar in mijn bestand.
Ik heb een bestand bijgevoegd met een gedeelte van mijn gegevens met het juist aantal kolommen.
Wat moet ik aanpassen in de macro, ik versta deze ook maar gedeeltelijk.
Nogmaals bedankt
Gr

 

[jkpieterse]

Ik snap niet waarom dat niet in een draaitbel gaat, zie Sheet1 in de bijlage.

 

[jefkeh]

Dit ziet er inderdaad ook goed uit, bedankt kan ik gebruiken.
Maar het andere had ik toch ook graag gezien.
Nogmaals bedankt.

 

[HSV]

Ik kan nog eens een poging wagen, maar ik weet niet welke kolommen je wilt zien.

 

[jefkeh]

Leverancier, omschrijving, aantal, eenheidsprijs.
Als ik weet hoe het in elkaar zit, probeer ik altijd wat aan te passen zodat ik het begrijp wat er gebeurt.
Dank u voor de snelle reactie.
Gr

 

[HSV]

Lijkt dit er op?

Sub hsv()
Dim sn, i As Long, Odic As Object
With Sheets("Blad1")
sn = .Cells(1).CurrentRegion
Set Odic = CreateObject("scripting.dictionary")
  For i = 2 To UBound(sn)
     Odic.Item(sn(i, 7) & sn(i, 1)) = Array(sn(i, 7), sn(i, 1), sn(i, 2), sn(i, 3))
  Next i
        .Cells(1, 10).Resize(Odic.Count, 4) = Application.Index(Odic.items, 0, 0)
        .Cells(1, 10).Sort [j1], 2, , , , , , xlNo
    sn = .Cells(1, 10).CurrentRegion
     For i = UBound(sn) To 2 Step -1
       If sn(i, 1) = sn(i - 1, 1) Then sn(i, 1) = ""
     Next i
        .Cells(1, 10).Resize(UBound(sn)) = sn
        .Columns(11).Insert
 End With
End Sub

 

[jefkeh]

Bedankt voor de nieuwe macro, en werkt perfect.
Nog een kleine vraag hierover;
als nu rij 1 tot 3 lege regels zouden zijn(dus de lijst begint op rij 4), wat dan.
Want als ik het goed begrijp begint die currentregion op rij 1 kolom 1
Nogmaals bedankt voor alles
Gr.

 

[HSV]

Op A4 met lege rijen erboven.

sn = .Cells(4,1).CurrentRegion