Rijen samenvoegen op basis van een 'sleutelcel'

[Atbiker]

Hallo,

Ik zit met een vraag waar ik alleen niet uit kom. Ik leg hem daarom graag hier voor.

In bijgaand bestand 'Regelvraag.xls' Heb ik twee regels staan die ik wil samenvoegen naar één regel. De 'sleutel' staat in kolom A. Als die identiek zijn kan ik ze samenvoegen.
De kolommen N + O zijn ook identiek aan elkaar en kunnen samengevoegd worden naar eenzelfde tekst. Kolom AK gebruik ik als telling voor mijn draaitabel en kan dus altijd 1 blijven.

Is dit op te lossen?

Met vriendelijke groeten,

Frans van Dommelen

 

[VenA]

Maak een voorbeeldbestand wat representatief is met wat meer dan twee rijen en plaats ook de verwachte uitkomst.

 

[HSV]

Test het eens.

Sub hsv()
Dim sn, c00 As String, i As Long, ii As Long, jjj As Long
sn = Cells(2, 1).CurrentRegion
ReDim arr(UBound(sn, 2), 0)
 For i = 1 To UBound(sn)
      If InStr(c00, "|" & sn(i, 1) & "|") = 0 Then
         c00 = c00 & "|" & sn(i, 1) & "|"
            For jjj = 0 To UBound(sn, 2) - 1
              arr(jjj, UBound(arr, 2)) = sn(i, jjj + 1)
            Next jjj
      
      For ii = i + 1 To UBound(sn)
         If sn(i, 1) = sn(ii, 1) Then
            For jjj = 0 To UBound(sn, 2) - 1
               If arr(jjj, UBound(arr, 2)) = "" Then arr(jjj, UBound(arr, 2)) = sn(ii, jjj + 1)
            Next jjj
         End If
      Next ii
     ReDim Preserve arr(UBound(sn, 2), UBound(arr, 2) + 1)
    End If
 Next i
  Cells(1).CurrentRegion.Clear
  Cells(2, 1).Resize(UBound(arr, 2), UBound(arr)) = Application.Transpose(arr)
End Sub

 

[Atbiker]

Dag Harry,

Een eerste test laat zien dat dit geweldig werkt. Ik ben zelf niet zo handig met deze code maar weet er wel mee om te gaan. Ik moet nog een paar dingetjes aanpassen in mijn hoofdbestand met meer dan 4000 regels maar het werkt perfect.

Ik kan weer verder met mijn opdracht. Geweldig bedankt!!

Met vriendelijke groeten,

Frans van Dommelen


PS VenA, ik snap wat je zegt en zal er bij een volgende keer aan denken om het iets groter te maken. Toch bedankt.