Fusionner des lignes en doublon et concaténer

[JoeGo]

Bonjour,

J'ai veillé à lire tous les sujets traitant des mêmes opérations mais aucun ne correspond : soit les formules dépassent le nombre de caractère autorisé (mon fichier complet contient 2923 lignes), soit les macros n'effectuent pas tout à fait les même opérations. J'ai beau tenté de modifier ces macros en VBA, mes compétences sont trop nulles pour y arriver.

Dans le fichier ci-joint, je cherche à ce que les lignes en doublons (mêmes valeurs pour toutes les colonnes à l'exception de la colonne H "Role") fusionnent pour qu'il n'en reste qu'une, comme c'est le cas ici :
https://www.excel-downloads.com/threads/fusionner-et-comptabiliser-les-doublons.94156/

Mais je cherche aussi à concaténer dans une colonne I les cellules de la colonne H pour ces lignes fusionnées.
Par exemple, obtenir à la ligne 20 "Ancien possesseur | Ancienne bibliothèque" (et donc que la ligne 21 soit supprimée).


Merci par avance pour toute réponse !

 

[thebenoit59]

Re : Fusionner des lignes en doublon et concaténer

Bonjour JoeGo.

Le code est assez lourd, il doit y avoir plus simple avec des boucles je pense.

Option Explicit

Sub Doublon()
Dim i As Long, j As Integer
Dim d As Object
Dim c As Variant
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To [a65000].End(xlUp).Row
    If Not d.exists(Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value & Cells(i, 7).Value) Then
    For j = 1 To 7
    d(Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value & Cells(i, 7).Value) = d(Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value & Cells(i, 7).Value) & Cells(i, j).Value & ":"
    Next j
    d(Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value & Cells(i, 7).Value) = d(Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value & Cells(i, 7).Value) & ":" & Cells(i, 8).Value
    Else: d(Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value & Cells(i, 7).Value) = d(Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value & Cells(i, 7).Value) & " | " & Cells(i, 8).Value
    End If
    Next i
    Range(Cells(2, 1), Cells([a56000].End(xlUp).Row, 9)).ClearContents
    i = 2
    For Each c In d.Keys
    Cells(i, 1).Resize(, 9) = Split(d(c), ":")
    i = i + 1
    Next c
    For Each c In d.Keys
    Debug.Print c & " - " & d(c)
    Next c
End Sub

 

[JoeGo]

Re : Fusionner des lignes en doublon et concaténer

Impeccable ! Un grand merci !