posities van component op 1 lijn

[Spiesse]

voor een offerte dient een collega het volgende te verwezenlijken:

in een tabel heeft hij een overzicht van 1902 plaatsen op een printplaat waar een component moet komen. (in bijlage een verkorte tabel).

nu wil hij per benodigd component in de cel ernaast (de unieke componenten zou ik bekomen via een draaitabel) alle plaatsen willen zien waarop dit bepaald component moet komen, gescheiden door een komma...

Ik vermoed dat een macro hiervoor het best op zijn plaats is...

zie bijlage voor het bestand.
Bekijk bijlage balancer.xlsx

alvast bedankt!
Spiesse

 

[Niels28]

Is dit niet leesbaarder?

Bekijk bijlage balancer.xlsx

Niels

 

[JeanPaul28]

Met een macro filter

 

[snb]

Sub M_snb()
   Cells(2, 7) = Join(Filter([transpose(If(B1:B2000=F2,A1:A2000,"~"))], "~", False), ",")
   Cells(3, 7) = Join(Filter([transpose(If(B1:B2000=F3,A1:A2000,"~"))], "~", False), ",")
End Sub

 

[HSV]

Nog maar eentje zonder gebruik van de draaitabel.

Sub hsv()
Dim dic As Object, Odic As Object, cl
Set dic = CreateObject("scripting.dictionary")
Set Odic = CreateObject("scripting.dictionary")
   For Each cl In Worksheets(1).ListObjects(1).ListColumns(2).DataBodyRange
     dic(cl.Value) = dic(cl.Value)
     Odic(cl.Value) = Odic(cl.Value) & cl.Offset(, -1).Value & ", "
   Next cl
 Range("J1").Resize(dic.Count) = Application.Transpose(dic.keys)
 Range("K1").Resize(Odic.Count) = Application.Transpose(Split(Join(Odic.items, vbLf), vbLf))
End Sub

 

[Spiesse]

Is dit niet leesbaarder?

Bekijk bijlage 219753

Niels

veel leesbaarder Niels, maar voor de offerte en bruikbaarheid in productie moeten de locaties in 1 cel genoteerd staan, met een komma gescheiden...

toch bedankt voor het voorstel

 

[Spiesse]

Sub M_snb()
   Cells(2, 7) = Join(Filter([transpose(If(B1:B2000=F2,A1:A2000,"~"))], "~", False), ",")
   Cells(3, 7) = Join(Filter([transpose(If(B1:B2000=F3,A1:A2000,"~"))], "~", False), ",")
End Sub

Hey SNB,

als ik uw macro doe lopen, zie ik op beide regels allemaal 0 (nullen) met een komma gescheiden... opzet is dus ok, enkel de locatie er nog bijkrijgen...

 

[Spiesse]

Nog maar eentje zonder gebruik van de draaitabel.

Sub hsv()
Dim dic As Object, Odic As Object, cl
Set dic = CreateObject("scripting.dictionary")
Set Odic = CreateObject("scripting.dictionary")
   For Each cl In Worksheets(1).ListObjects(1).ListColumns(2).DataBodyRange
     dic(cl.Value) = dic(cl.Value)
     Odic(cl.Value) = Odic(cl.Value) & cl.Offset(, -1).Value & ", "
   Next cl
 Range("J1").Resize(dic.Count) = Application.Transpose(dic.keys)
 Range("K1").Resize(Odic.Count) = Application.Transpose(Split(Join(Odic.items, vbLf), vbLf))
End Sub

HSV, denk dat deze het doet!

thx
Spiesse

 

[snb]

Dan heb je de code in een ander bestand gezet dan het bestand dat je hier geplaatst hebt.

Je moet de code dan natuurlijk wel aanpassen.

 

[Spiesse]

snb,

tuurlijk... man man, goe bezig ikke
sorry voor het twijfelen aan jouw kunnen

heb je mss de uitbreiding ook in jouw vingers zitten? Namelijk dat ik kan zien hoeveel plaatsen per component bezet zijn adhv het aantal komma's die gebruikt worden ...

 

[snb]

wat dacht je van

Sub M_snb()
   Cells(2, 8) = ubound(Filter([transpose(If(B1:B2000=F2,A1:A2000,"~"))], "~", False))+1
   Cells(3, 8) = ubound(Filter([transpose(If(B1:B2000=F3,A1:A2000,"~"))], "~", False))+1
End Sub[

maar naruulijk veel simpeler met aantal.als(B1:B2000;F2)

 

[Spiesse]

bedankt snb,

bestand is aangepast en goedgekeurd.

Dank aan allen voor de hulp!

Deze gaat op opgelost

Groeten en tot het volgend draadje
Spiesse