Uitdaging unieke combinaties

[DJ.Funny]

Ik heb een vrij lange lijst waar in kolom 1 een artikel nummer staat en in kolom 2 een code. Een artikel in kolom 1 kan vervangen worden door een artikel met dezelfde code in kolom 2. Ik heb een excel bijgevoegd met in blad1 de originele file (althans een voorbeeld) en op blad 2 het resultaat!

Wat ik ook probeer het lukt mij niet??? Ideeen zat maar elke keer stranden ze. Ook het feit dat niet elk artikel kan worden vervangen door 1 artikel maar sms zelfs 50 artikelen dus 49 rijen invoegen kom ik niet uit!?!?!?

Iemand de oplossing

Alvast bedankt!!!

 

[Thankyou]

48x is vraag gelezen - 11x is je bestand bekeken . . . . .
Als je nu nog geen antwoord hebt ben ik waarschijnlijk niet de enige die hier geen b.. van snap.

Succes,

 

[popipipo]

Misschien is Funny de enigste die het begrijpt

 

[Thankyou]

@ popipipo
Waarschijnlijk heeft hij/zij alleen de bovenste regel van jouw handtekening gelezen en de mijne helemaal niet . . .

 

[HSV]

maar sms
Alvast bedankt!!!

Ik weet al waarom het mij niet wil lukken.

Ik heb je telefoonnummer niet.

 

[WHER]

Ik gok op deze:

 

[HSV]

Ik had er even vlugtig naar gekeken, en zag er geen logica in.

Maar dit is wel heel knap WHER.
Dat je begrijpt wat er wordt bedoeld, maar dan ook nog maken. (ik begrijp het nog steeds niet).

Proficiat. :thumb:

Ps. Ondertussen wel.

 

[Warme bakkertje]

Ik begrijp 'm ook (denk ik )
'T is niet de mooiste maar hij doet het wel (hoop ik )

Sub tst()
With Sheets("Blad1")
    For Each cl In .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
        i = WorksheetFunction.CountIf(.Range("B1:B" & .Cells(Rows.Count, 1).End(xlUp).Row), "=" & cl.Offset(, 1).Value) - 1
        Sheets("Blad2").Range("A65536").End(xlUp).Offset(1).Resize(i, 2) = cl.Resize(, 2).Value
        For Each c In .Range("B1:B" & .Cells(Rows.Count, 1).End(xlUp).Row)
            If c = cl.Offset(, 1) And c.Offset(, -1) <> cl Then Sheets("Blad2").Range("C65536").End(xlUp).Offset(1) = c.Offset(, -1)
        Next
    Next
End With
End Sub

 

[DJ.Funny]

Sorry dat ik onduidelijk was!!!

Sorry allemaal,

Dat mijn verhaal zo onduidelijk was!! En heb ook nog in een hotel gezeten met de vrouw (was verrassing), zodat ik nu pas ook alle reacties zie! De voorbeeld Excel doet precies wat ik wil, helaas zijn het formules en geen macro, maar ben al super blij! Gaat om in totaal 15000 artikelen en bij elkaar (ben nog niet helemaal klaar zo'n 200.000 mogelijkheden).

Toch nog een poging om e.e.a. uit te leggen:

Elk produkt in kolom A kent een koppelcode indien een product uit kolom A niet aanwezig is kan een ander artikel verkocht worden met dezelfde koppelcode.

Dus indien product in A1 niet aanwezig is kan ik ook artikel uit A2, A3, A4 omdat zij allen dezelfde koppelcode.

Nu moet dit geimporteerd worden in software en deze software wil alleen maar weten door welke produkten kan product uit A1 allemaal vervangen worden!

Bedankt en indien iemand een macro weet voor +15000 artikelen dan houd ik mij aanbevolen. Met de macro van warme bakkertje kwam ik niet uit de voeten, het lukte me niet om deze uit te breiden naar 15000+ artikelen.

Groeten Dirk

 

[Warme bakkertje]

Waarschijnlijk te weinig rijen (XL2003) Probeer eens met deze

Sub tst()
With Sheets("Blad1")
    For Each cl In .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
        i = WorksheetFunction.CountIf(.Range("B1:B" & .Cells(Rows.Count, 1).End(xlUp).Row), "=" & cl.Offset(, 1).Value) - 1
        Sheets("Blad2").Range("A1048576").End(xlUp).Offset(1).Resize(i, 2) = cl.Resize(, 2).Value
        For Each c In .Range("B1:B" & .Cells(Rows.Count, 1).End(xlUp).Row)
            If c = cl.Offset(, 1) And c.Offset(, -1) <> cl Then Sheets("Blad2").Range("C1048576").End(xlUp).Offset(1) = c.Offset(, -1)
        Next
    Next
End With
End Sub

 

[HSV]

Anders gebruik je Cells(rows.count,1) in je code Rudi.

Ik vind het prachtig (hoe verzin je het). :thumb: