Microsoft 365 Gestion des doublons

[Usine à gaz]

Bonsoir à toutes et à toute
Me voilà avec une nouvelle opération à réaliser que je n'arrive pas à faire malgré mes recherches
et essais. Faut dire (enfin pour moi), que c'est certainement un codage ardu !
P'tit exposé de la situation :
Dans notre fichier de travail, quand nous appelons un nouveau prospect, nous créons une ligne d'appel.
Mais il arrive que nous ne nous apercevions pas que nous avons déjà appelé et déjà créé une ligne d'appel et que nous créions, par erreur une nouvelle ligne = doublon !
Le souci est que nous avons les commentaires des 1er appels dans la 1ère ligne créée et les commentaires des appels suivants dans la ligne doublon (ou dans les lignes doublons).
Pire encore, il peut y avoir des commentaires mélangés dans les 2 ou les 3 (voire 4) lignes doublons.

J'ai codé pour trouver les doublons et faire un classement pour trier n° par numéro comme dans le fichier test joint. J'en suis à ce niveau actuellement.

Ce que je voudrais pouvoir faire :
En vérifiant les doublons, dans mon fichier actuellement il y a 144 doublons avec des commentaires comme dans l'exemple du fichier test joint.... et tout remettre manuellement est long et fastidieux !

Partant du principe que les commentaires commencent tous avec une date comme ci-dessous :
"- 05/11/19 Consulte conjoint , Rap : OUI + OK RDV SPV"

Ce serait super bien que les commentaires des doublons soient rassemblés automatiquement par l'exécution d'un code (secret pour moi LOL) dans la 1ère ligne et que les commentaires de la ou des lignes en doublons soient effacés
fichier test joint :
- Feuille "doublons",
- Feuille "résultat attendu".
Si un magicien pouvait m'aider ?

Avec mes remerciements pour m'avoir lu en espérant être clair,
Je vous souhaite à toutes et à tous une bonne fin de journée,
Amicalement,
lionel,

 

[laurent950]

les parenthéses je pense

 

[Usine à gaz]

OK, je vais voir, dans tous les cas, je te remercie pour ton formidable travail qui de toute façon va m'être très utile
Tu es un magicien
Je suis sur une piste pour compléter par une formule qui devrait résoudre le souci 1.
Je te dirai quand j'aurai fini

 

[laurent950]

avec plaisir

 

[Usine à gaz]

Je deviens abonné aux Laurent LOL
Un autre Laurent (Laurent3372) à trouvé une amélioration et il ne manque plus de commentaires après traitement
(sauf erreur de ma part)
https://www.(sauf erreur de ma part=excel-downloads.com/threads/supprimer-doublons-a-linterieur-des-cellules-et-classer-le-texte-restant-par-ordre-de-dates.20041050/
Mais il reste toujours quelques commentaires en doublons.
C'est jouable comme ça

 

[job75]

Bonsoir Lionel, le forum,

Je me demande bien ce qui va se passer quand il y aura 1000 commentaires à concaténer pour un même appel téléphonique.

Il serait quand même plus simple de mettre les commentaires à la suite dans les cellules à droite, les derniers en tête bien sûr.

Sauf si l'on est un inconditionnel des usines à gaz.

A+

 

[Usine à gaz]

Bonjour Laurent, le Forum
Cher Laurent, je te remercie encore pour ton super boulot.
J'ai déjà pu travailler, même s'il subsiste quelques soucis et c'est super !!
Je vais demander à Gérard s'il veut bien y "jeter" un oeil. C'est un super technicien et si ce codage retient son attention, je pense qu'il pourra nous apporter la solution
Bonne journée Laurent ... à toutes et à tous,
Amicalement,
lionel,

 

[Usine à gaz]

Bonjour Gérard,

Merci, comme toujours, pour tes observations et ta gentillesse
"Je me demande bien ce qui va se passer quand il y aura 1000 commentaires à concaténer pour un même appel téléphonique. "

Nous mettons nos commentaires, à la suite dans une même cellule (cela permet de ne pas multiplier les colonnes) et je ne peux plus changer cela car il faudrait complètement refaire le fichier ainsi que les fichiers qui en dépendent.

Laurent 950 et Laurent 3372 on pratiquement trouvé le bon code (merci à eux) mais il reste 1 souci :

Il y a des commentaires en doublons :
exemple ligne 41
+++- 21/10/19 Pas maintenant- tente seul(e) , Rap : OUI + OK RDV SPV - 18/11/19 Pas de pros , Rap : OUI va rencontrer une agence et ver dans 2 sem - 02/12/19 Répondeur - 03/12/19 Répondeur - 03/12/19 Répondeur - 03/12/19 A des visites pas maintenant , Rap : OUI 1A - 08/01/20 Répondeur - 29/01/20 , Ré +++- 21/10/19 Pas maintenant- tente seul(e) , Rap : OUI - 18/11/19 Pas de pros , Rap : OUI va rencontrer une agence et ver dans 2 sem - 02/12/19 Répondeur - 03/12/19 Répondeur - 03/12/19 Répondeur - 03/12/19 A des visites pas maintenant , Rap : OUI 1A - 08/01/20 Répondeur - 29/01/20 , Rép

En cas que tu veuilles regarder, je joins le fichier test
lionel,

 

[laurent950]

Bonjour lionel, Job75, Le forum.
Le codes fonctionnes à présent.
Votre fichier du poste #37 (Doublons_laurent3372 (LIGNE 41).xlsm)
Puis un autres (Doublons_test (02_Deuxieme code afiné).xlsm), avec plusieurs lignes de commentaires rajouté en doublon pour test

Même code pour les deux fichiers

 

[laurent950]

Bonjour au forum.

+++- 21/10/19 Pas maintenant- tente seul(e) , Rap : OUI + OK RDV SPV - 18/11/19 Pas de pros , Rap : OUI va rencontrer une agence et ver dans 2 sem - 02/12/19 Répondeur - 03/12/19 Répondeur - 03/12/19 Répondeur - 03/12/19 A des visites pas maintenant , Rap : OUI 1A - 08/01/20 Répondeur - 29/01/20 , Ré +++- 21/10/19 Pas maintenant- tente seul(e) , Rap : OUI - 18/11/19 Pas de pros , Rap : OUI va rencontrer une agence et ver dans 2 sem - 02/12/19 Répondeur - 03/12/19 Répondeur - 03/12/19 Répondeur - 03/12/19 A des visites pas maintenant , Rap : OUI 1A - 08/01/20 Répondeur - 29/01/20 , Rép

Ici comment trouver la racine de la chaine de caractère qui correspond à un doublon !
c'est impossible a créer une régle je pense dans ces conditions !
Je pense que Job75 à raison (pour ne pas dire qu'il à vraiment l'expérience et aussi raison de se qu'il vous à dit à son poste #35
Laurent

 

[Usine à gaz]

Re-Laurent,

Je suis d'accord et Gérard a une parole en OR
Mais je pense que je vais trouver la solution qui ne provient peut-être pas d'un souci de codage mais de nos commentaires.

Je reviendrai dire ce que j'aurai trouvé.
Bonne journée

 

[laurent950]

Tu as regardé en poste #38
C est le même code sur les deux fichiers
Chaques fichier et différents
Pour comparer les résultats

 

[Usine à gaz]

OUI, j'ai regardé effectivement (hier, je ne devais plus avoir les yeux bien centrés lol)

 

[job75]

Je fais suite à mon post #35.

Dans le fichier joint (dérivé de celui du post #1) l'actvation de la feuille "Classement" permet de supprimer les doublons et de classer par dates décroissantes :

Private Sub Worksheet_Activate()
Dim colmax%, tablo, d As Object, i&, numero, a, b, s, ub%, n&, c$(), j%, dat, col%
colmax = 10000 'nombre maximum de colonnes du tableau des résultats, adaptable
With Sheets("Doublons")
    With .Range("A1", .UsedRange)
        tablo = .Resize(, 31) 'matrice, plus rapide
    End With
End With
ReDim resu(1 To UBound(tablo), 1 To colmax)
Set d = CreateObject("Scripting.Dictionary")
For i = 6 To UBound(tablo)
    numero = tablo(i, 7)
    If numero <> "" Then d(numero) = d(numero) & tablo(i, 31) 'concaténation
Next i
If d.Count = 0 Then Exit Sub 'sécurité
a = d.keys: b = d.items
For i = 0 To UBound(a)
    s = Split(b(i), "-") 'tiret devant les dates
    ub = UBound(s)
    If ub > -1 Then
        n = n + 1
        ReDim c(ub)
        For j = 0 To UBound(s)
            dat = Replace(Left(Trim(s(j)), 8), ".", "/")
            If IsDate(dat) Then c(j) = Format(CDate(dat), "yy/mm/dd") & Mid(Trim(s(j)), 9) 'permet le tri par dates
        Next j
        tri c, s, 0, ub
        resu(n, 1) = a(i)
        col = 1
        For j = ub To 1 Step -1
            If Replace(Replace(s(j), " ", ""), ".", "/") <> Replace(Replace(s(j - 1), " ", ""), ".", "/") Then 'ne tient pas compte des doublons
                col = col + 1
                resu(n, col) = s(j)
            End If
        Next j
        If Trim(s(0)) <> "" Then resu(n, col + 1) = s(0)
    End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution, à adapter
    If n Then .Resize(n, colmax) = resu
    .Offset(n).Resize(.Parent.Rows.Count - n - .Row + 1, colmax).ClearContents 'RAZ au dessous
End With
Columns.AutoFit 'ajustement largeur
With UsedRange: End With 'actualise les barres de défilement
End Sub

Sub tri(a, b, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      temp = b(g): b(g) = b(d): b(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, b, g, droi)
If gauc < d Then Call tri(a, b, gauc, d)
End Sub

Tu en fais ce que tu veux Lionel mais la disposition en colonnes est la plus logique et la plus simple.

 

[Usine à gaz]

Merci Gérard, je regarde dès que j'ai un moment (je pense ce soir),
lionel

 

[patricktoulon]

re
bonjour a tous j'arrive un peu tard dans la discussion mais bon
donc si je me réfère a la demande si bien sur je l'ai bien comprises
on part de ca (j'ai mis les portion de phrase en evidence (rouge)
donc au début on a ca

et on veut ce résultat
j'ai remis ce qui etait en doublons et qui ne l'est plus en rouge

le code est assez simple

Sub test()
    Dim newval$, i&, Firstindex&, texte$
    newval = ""
    For i = 6 To Cells(Rows.Count, "G").End(xlUp).Row
        If Cells(i, "G") <> newval Then
            Firstindex = i
            newval = Cells(i, "G")
            texte = ""
        Else
            If Cells(i, "AE") <> "" Then
                Cells(Firstindex, "AE") = Cells(Firstindex, "AE") & " - " & Cells(i, "AE"): Cells(i, "AE") = ""
                'on enleve les doublons(texte dans le resultat en first cellule de chaque valeur
                'en gros on suprime les chaines qui se repete mot pour mots
                t = Split(Cells(Firstindex, "AE"), "-")
                For x = 0 To UBound(t)
                    If Not Trim(t(x)) = "" And Not texte Like "*" & t(x) & "*" Then texte = texte & "-" & t(x)
                Next
                If Left(texte, 1) = "-" Then texte = Mid(texte, 2)
                Cells(Firstindex, "AE") = texte
            End If
        End If
    Next i
End Sub

demo

bonne journée