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,

 

[job75]

J'ai légèrement modifié ma macro du post #43 et testé en copiant les lignes 6:14 sur 9000 lignes.

La macro s'exécute en 1,4 seconde.

Salut patricktoulon.

 

[job75]

Je reconnais que la solution de patricktoulon est la plus simple.

Dans la mesure où les textes concaténés ne sont pas trop longs.

 

[patricktoulon]

bonjour job75
ok c'est la même mais avec une variable tableau et avec le tri des dates en plus

 

[patricktoulon]

Je reconnais que la solution de patricktoulon est la plus simple.

Dans la mesure où les textes concaténés ne sont pas trop longs.

si on fait la même chose sur une variable tableau ça devrait largement accélérer non ?
et on retranscrirais que le index(tableau,0,nextcolonne) dans "AE"
on génère un seul calculate et quoi que enableevents=false et voila
je suis tenté de le faire pour m’amuser un peu

 

[Usine à gaz]

Re-Gérard
Bonjour Patrick ... vieux motard que j'aimais lol ... Merci d'être là.
Je suis en réunion jusqu'à ce soir. je regarderai et je vous dirai
lionel,

 

[Usine à gaz]

LOL n'hésite pas ... amuses-toi Patrick

 

[job75]

@patricktoulon sur mon fichier en AE11 ta macro ne donne pas le bon résultat (doublon sur 09/11/19).

 

[patricktoulon]

re
a bon ?
ok trim(t(x))
testé sur ton fichier post # 43
on est bon

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 "*" & Trim(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

 

[job75]

OK maintenant c'est bon.

 

[patricktoulon]

re
sinon avec une variable tableau

Sub test()
    Dim newval$, i&, Firstindex&, texte$,tableau
    newval = ""
    tableau = Range("A6:AE" & Cells(Rows.Count, "A").End(xlUp).Row)
    For i = 1 To UBound(tableau)
        If tableau(i, 7) <> newval Then
            Firstindex = i
            newval = tableau(i, 7)
            texte = ""
        Else
            If tableau(i, 31) <> "" Then
                tableau(Firstindex, 31) = tableau(Firstindex, 31) & " - " & tableau(i, 31): tableau(i, 31) = ""
            End If
            '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(tableau(Firstindex, 31), "-")
            For x = 0 To UBound(t)
                If Not Trim(t(x)) = "" And Not texte Like "*" & Trim(t(x)) & "*" Then texte = texte & "-" & t(x)
            Next
            If Left(texte, 1) = "-" Then texte = Mid(texte, 2)
            tableau(Firstindex, 31) = texte
        End If
    Next i

Application.EnableEvents = False
Cells(6, "AE").Resize(UBound(tableau), 1) = WorksheetFunction.Index(tableau, 0, 31) 'on retranscrit que la colonne 31 "AE"
Application.EnableEvents = True
End Sub

 

[patricktoulon]

re et oui suis-je bête
et pour encore plus accélérer je travaille le split du texte 1 seule fois par valeur en amont juste avant de d'entamer une newval(nouvelle valeur ) si firstindex >0

Sub test()
    Dim newval$, i&, Firstindex&, texte$
    newval = ""
    tableau = Range("A6:AE" & Cells(Rows.Count, "A").End(xlUp).Row)
    For i = 1 To UBound(tableau)
        If tableau(i, 7) <> newval Then
            If Firstindex > 0 Then
                t = Split(tableau(Firstindex, 31), "-")
                For x = 0 To UBound(t)
                    If Not Trim(t(x)) = "" And Not texte Like "*" & Trim(t(x)) & "*" Then texte = texte & "-" & t(x)
                Next
                If Left(texte, 1) = "-" Then texte = Mid(texte, 2)
                tableau(Firstindex, 31) = texte
            End If
            Firstindex = i
            newval = tableau(i, 7)
            texte = ""
        Else
            If tableau(i, 31) <> "" Then
                tableau(Firstindex, 31) = tableau(Firstindex, 31) & " - " & tableau(i, 31): tableau(i, 31) = ""
            End If
            '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
        End If
    Next i

    Application.EnableEvents = False
    Cells(6, "AE").Resize(UBound(tableau), 1) = WorksheetFunction.Index(tableau, 0, 31)    'on retranscrit que la colonne 31 "AE"
    Application.EnableEvents = True
End Sub

un peu moins de 2 secondes sur 14000 ligne les ref le tableau ayant été copié x fois jusqu’à la ligne 14000

on s'amuse comme des petits fou avec les projets de arthour ca détend

 

[Usine à gaz]

Bsr chers Gérard, Patrick, Nos 2 laurent et chers tous,
Je viens de rentrer. je suis désolé mais trop fatigué pour tester vos super codes.
Je suis content que tu dises cela Patrick : "on s'amuse comme des petits fou avec les projets de arthour ca détend" LOL
J'en ai d'autres sous le coude mais tellement occupé et fatigué que je n'ai pas le temps, ni la force de préparer les exposés et les fichiers tests mais ça viendra lol.
Vous avez vu comme j'expose bien depuis quelque temps ? LOL
Bonne nuit chers tous.
A demain j'espère,
Amicalement,
lionel,

 

[laurent950]

Bonjour Lionel, job75, Patrick, le forum.

J'ai vu ton code qui est magnifique Patrick, pour ma part le miens est moins élégant mais en Poste# 20 (mon poste = posté un fichier) j'ai tenté une regex mais bon le résulta n est pas probant pourtant il devrait être correct (je n arrive pas a comprendre pourquoi !?)
Même si la regex c'est lourd mais pour la forme si tu arrive à trouvé cette anomalie du code (C est à dire que le test de l expression régulière qui devrait être vrais n est pas reconnu est elle est fausse?)
Je serais content si tu m aide sur ce point.
Pour info j'ai réussi à comprendre et utiliser les (optinal) dans une fonction je suis très content !
Merci Patrick

 

[patricktoulon]

re
bonjour laurent je viens de regarder ton fichier

deja une question
qu'est ce que vous avez tous a compliquer quelque chose de simple
puré ton code pique les yeux

le pattern
reg.Pattern = tab1(j, 31) je suppose que tab1(j, 31) correspond a la cells(j,31)
conclusion ton patern contient le texte entier de la cellule en "AE"
dis moi un peu a quoi ca sert ca n'est pas ca que l'on veux faire
les doublons c'est dans les portions de texte dans la chaîne complète de la compilation

 

[laurent950]

reg.Pattern = tab1(j, 31) je suppose que tab1(j, 31) correspond a la cells(j,31)

L idée était la suivante. Avant de reconstitué la concaténation des commentaires alors je regarde le commentaire à récupérer (C est à dire celui en cells(J,31) qui correspond bien sur au reg.pattern = cells(J.31) ensuite donc comme c'est une boucle et que j'ai déjà concaténer au paravent c est différent commentaire dans une chaîne que je vais appeler dans l'exemple ( text = Dim tex as string) c est pas dans mon code mais pour l exemple que je décrit... alors quand j arrive à cette instant dans la boucle je test avec cette fonction regex / reg.test(text) si le test est vrai c est que mon pattern est bien déjà présent dans la chaîne et que ne je n ai pas besoin de le concaténer mais dans le cas contraire il n est pas présent (donc faux) et il faut le concaténer
Soit text = text & cells(J,31) "qui est bien mon perttern non trouvé suite au test reg.test(text) qui est effectivement faut
J'ai essayé de te faire comprendre ma logique Patrick ?
Et c est ici que je comprends pas pourquoi cela ne fonctionne plus ? Ou pas ?
En tous cas un grand merci d avoir regardé Patrick si tu trouve la solution c est Top