Fusionner des lignes en doublon et concaténer

  • Initiateur de la discussion Initiateur de la discussion JoeGo
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

JoeGo

XLDnaute Nouveau
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 !
 

Pièces jointes

Dernière modification par un modérateur:
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.

Code:
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
26
Affichages
1 K
Réponses
3
Affichages
469
Compte Supprimé 979
C
Retour