Waarden naast elkaar plaatsen van meerdere regels - Macro of Formule

[jerxjac]

Ik heb op dit forum twee post gevonden die een beetje doen wat ik nodig heb, maar net niet.
De eerste is Waarden naast elkaar plaatsen van meerdere regels in Excelhttps://www.helpmij.nl/forum/showth...ast+elkaar+plaatsen+van+meerdere+regels+Excel, dit werkt goed maar zodra ik in kolom A een alphanumerieke waarde invul doet hij het niet meer. Lijkt erop dat deze formule alleen werkt met getallen.
Is er een manier om deze formule aan te passen zodat hij ook alphanumeriek accepteerd?

In het voorbeeld bestand wil ik op Sheet 2 op één regel het artikelnummer (kolom A, B, C) met daar achter de onderdelen uit Kolom D, E, F, G.
Het zijn in totaal 5000 artikelen en elk artikel kan uit 3 tot meer dan 10 regels bestaan.

Nu kan het zo zijn dat bovenstaande oplossing te veel rekenkracht vergt en dus niet haalbaar kan zijn,..

In dat geval was er ook nog de post van Mhunt Data uit kolom in rijen zetten.
Maar de macro die hier vermeld staat is abracadabra voor mij,. Het lukt mij niet om te achterhalen hoe deze werkt en dus aangepast kan worden aan mijn wensen.

Sub tsh()
    Dim Br
    Dim y As Long, i As Long, j As Long
    Dim It, Ix
    
    Br = Cells(1).CurrentRegion
    y = 5 * Evaluate("Max(CountIf(A2:A" & UBound(Br) & ",A2:A" & UBound(Br) & "))") + 1
    ReDim Ix(y)
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(Br)
            It = .Item(Br(i, 1))
            If IsEmpty(It) Then It = Ix
            It(0) = Br(i, 1)
            For j = 0 To 4
                It(j + It(y) * 5 + 1) = Br(i, j + 2)
            Next
            It(y) = It(y) + 1
            .Item(Br(i, 1)) = It
        Next
        Sheets(Application.Max(2, Sheets.Count)).Cells(2, 1).Resize(.Count, y) = Application.Index(.Items, 0)
    End With
End Sub

Ik hoop dus dat er iemand is die mij hiermee verder kan helpen.

 

[Timshel]

Zoiets?

Sub tsh()
    Dim Br
    Dim i As Long
    Dim Sh As Object
    
    Br = Sheets(1).Cells(1).CurrentRegion
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Br)
            .Item(Br(i, 1) & "|" & Br(i, 2) & "|" & Br(i, 3)) = .Item(Br(i, 1) & "|" & Br(i, 2) & "|" & Br(i, 3)) & _
                Br(i, 4) & "|" & Br(i, 5) & "|" & Br(i, 6) & "|" & Br(i, 7) & "|"
        Next
        Set Sh = Sheets(2)
        Sh.Cells(1, 1).Resize(.Count) = Application.Transpose(.Keys)
        Sh.Columns(1).TextToColumns , xlDelimited, , , , , , , 1, "|"
        Sh.Cells(1, 4).Resize(.Count) = Application.Transpose(Filter(.Items, ""))
        Sh.Columns(4).TextToColumns , xlDelimited, , , , , , , 1, "|"
    End With
End Sub

 

[jerxjac]

Dank je Timshel dit werkt zo te zien perfect :thumb:

Helaas snap ik nog niet veel van de code