Gegevens uit meerdere cellen kopiëren naar 1 cel

[BJansen1984]

Goedemiddag,

Ik zit met een issue waar ik niet uitkom.
Voor een productdatabase ben ik bezig met een "bijbehorende producten" kolom.

Deze kan natuurlijk handmatig worden ingevoerd, maar bij een product database van 12.000 producten is dit nogal een klus.

In kolom A staan de verschillende artikelnummers, kolom B het model waarvoor het artikelnummer in kolom A geschikt voor is en kolom C zou de bijbehorende producten moeten gaan herbergen.
De gegevens in kolom C dienen ; gescheiden te zijn.

Nu zou ik natuurlijk in cel C2 de formule =A2&";"&A3&"... kunnen gebruiken
Maar ik ben eigenlijk op zoek naar een formule die aan de hand van de waarde(s) in kolom B de bijbehorende artikelnummers uit kolom A in kolom C kan verwerken.

Misschien is het helemaal niet mogelijk, maar ik denk ik vraag het toch eens hier.

Met vriendelijke groet,

Bas Jansen

 

[gast0660]

Zoiets?
Voorzetje

 

[BJansen1984]

@ gast0660

dat is op zich een hele goede opzet.
Zou deze macro even moeten toepassen op een groter bestand om te kijken of het op grote schaal ook zo goed werkt.

 

[gast0660]

Hoi,
Zolang de waardes in kolom B in groep staan zou het moeten werken.
alle 4600 nrs onder elkaar etc.

 

[Timshel]

Eventuele alternatieve methode:

Sub tsh()
    Dim Br
    Dim i As Long
    
    Br = Cells(1).CurrentRegion.Resize(, 3)
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(Br)
            .Item(Br(i, 2)) = .Item(Br(i, 2)) & ";" & Br(i, 1)
        Next
        For i = 2 To UBound(Br)
            Br(i, 3) = Mid(.Item(Br(i, 2)), 2)
        Next
    End With
    Cells(1).CurrentRegion.Resize(, 3) = Br
End Sub

 

[MarcelBeug]

Een formule-oplossing, met dezelfde voorwaarde als in post #4 (waarden in kolom B gegroepeerd bij elkaar) en op voorwaarde dat je beschikt over Excel 2016, in C2 en kopiëren naar beneden:

=TEKST.COMBINEREN(";";0;VERSCHUIVING(INDEX(A:A;VERGELIJKEN(B2;B:B;0));0;0;AANTAL.ALS(B:B;B2)))

 

[BJansen1984]

Hij lijkt inderdaad prima te werken!

Nu ben ik niet echt thuis in macro's en visual basic.
Is het mogelijk om in de formule standaard de waarde 6 ook als resultaat mee te nemen?

 

[MarcelBeug]

Is "hij" gast0660, Timshel of MarcelBeug?

Formule met waarde 6 is gewoon "6;"& er voor zetten:

="6;"&TEKST.COMBINEREN(";";0;VERSCHUIVING(INDEX(A:A;VERGELIJKEN(B2;B:B;0));0;0;AANTAL.ALS(B:B;B2)))

 

[BJansen1984]

Ik had de reacties van Timshel en MarcelBeug nog niet gezien excuses.

Ik ben overgerens nu thuis bezig waar ik enkel Excel 2007 tot mijn beschikking heb.

Ik zal morgen ook jouw (MarcelBeug) formule eens loslaten op een systeem waar ik wel Excel 2016 tot mijn beschikking heb.

 

[Timshel]

Je kunt de code van Dotchie aanpassen:

Sub Dotchie()
    Dim Data, Results
    Dim lr As Long, i As Long
    
    lr = Range("A" & Rows.Count).End(xlUp).Row
    ReDim Results(1 To lr, 1 To 1) As String
    With Range("A1:B" & lr)
        Data = .Value
        For i = 2 To lr
            If Data(i, 2) = Data(i - 1, 2) Then
                Results(i, 1) = Results(i - 1, 1) & ";" & Data(i, 1)
                Results(i - 1, 1) = ""
            Else
                Results(i, 1) = "6;" & Data(i, 1)
            End If
        Next i
        .Offset(, 2).Resize(, 1).Value = Results
    End With
End Sub

Of de mijne gebruiken :evil::evil:

Sub tsh()
    Dim Br
    Dim i As Long
    
    Br = Cells(1).CurrentRegion.Resize(, 3)
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(Br)
            .Item(Br(i, 2)) = .Item(Br(i, 2)) & ";" & Br(i, 1)
        Next
        For i = 2 To UBound(Br)
            Br(i, 3) = 6 & .Item(Br(i, 2))
        Next
    End With
    Cells(1).CurrentRegion.Resize(, 3) = Br
End Sub