XL pour MAC Surligner les mots similaire dans une liste

[arico55]

Bonjour à tous,
J'ai besoin de votre aide.

J'ai une liste de 2700 mots clés.
certains d'entre sont assez similaires exemple
- chat > chats,
- sans abris > sans-abris (avec le tiret)

J'aimerais surligner tous les mots ayant des similitude (1 caractère près), est-ce possible ?
Si oui comment faire ?
Bonne soirée à tous.

 

[excfl]

Bonsoir le forum,

Voir le fichier joint :

 

[arico55]

Bonsoir le forum,

Voir le fichier joint :

Merci pour ta réponse, mais je crains que cela ne fonctionne pas pour mon cas.
Ma liste se présente plutôt comme ci-joint.

 

[patricktoulon]

bonsoir
c'est quoi cette liste on la compare a quoi

 

[arico55]

bonsoir
c'est quoi cette liste on la compare a quoi

j'aimerais comparer les mots entre eux et mettre en avant les mots ayant des similitude entre eux (1 caractère près)

Exemple dans la meme liste je trouve :
Chat
Chats

Chien
Chiens
Merci

 

[excfl]

Re,

Merci pour ta réponse.

Et, bonne lecture à tous.

 

[jmfmarques]

Bonjour

J'aimerais surligner tous les mots ayant des similitude (1 caractère près)

Il faudra avoir vraiment la certitude de ce que la seule différence d'un caractère suffit à déterminer la "similitude" (ou similarité ?)
Les mots suivants :
Cil, col, cal, cul présentent par exemple tous entre eux, une différence d'un seul caractère, mais on pourrait avoir des difficultés à leur trouver une similitude ou similarité. La chose se complique encore en partant de chacun d'entre eux (col et cou puis cru , par exemple)
Je crains personnellement assez que les approches de l'espèce ne soient finalement très hasardeuses.

 

[JHA]

Bonjour à tous,

Un début de piste par MFC

=NB.SI($A$2:$A$2725;$A2&"*")>1

Liste en mode tableau
trier la liste pour afficher les différences

JHA

 

[job75]

Bonjour arico55 et les autres,

Surligner ne paraît pas une bonne idée, il vaut mieux lister les numéros des lignes similaires.

Sur MAC le Dictionary n'existe pas, il faut utiliser une collection, voyez le fichier joint et cette macro :

Sub Compare()
Dim CollectLigne As New Collection, tablo, resu(), i&, x$, j%, y$
On Error Resume Next
With [A1].CurrentRegion
    tablo = .Resize(, 2) 'matrice plus rapide, au moins 2 éléments
    ReDim resu(1 To UBound(tablo), 1 To 1)
    '---collection des textes réduits de 1 caractère---
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        For j = 1 To Len(x)
            y = Left(x, j - 1) & Mid(x, j + 1) 'texte réduit
            CollectLigne.Add i, y 'mémorise la ligne
    Next j, i
    '---remplissage de resu---
    resu(1, 1) = "Ligne similaire"
    For i = 2 To UBound(tablo)
        resu(i, 1) = CollectLigne(tablo(i, 1))
    Next i
    '---restitution---
    .AutoFilter: .AutoFilter 'si le tableau est filtré
    .Columns(2) = resu
End With
End Sub

Edit : j'ai ajouté une 3ème colonne Texte similaire avec une formule très simple.

Nota : j'ai enregistré le fichier pour Excel 97-2003 car le fichier du post #3 ne permet pas le VBA.

A+

 

[job75]

Ci-joint zippée une solution par formules, indispensable avec le format du fichier du post #3.

Le nombre maximum de caractères en colonne A est 29, on utilise donc 29 colonnes auxiliaires B:AD (à masquer).

Bien sûr le recalcul des formules matricielles en colonne AE prend du temps, en particulier à l'ouverture.

Edit : si l'on veut masquer les valeurs zéro en colonne AE utiliser le format personnalisé 0;;

 

[jmfmarques]

Re
Aucune solution de détermination de "similarité" ne sera exempte de failles.
et dans un tel cas :
1) autant seront trouvées certaines similarités et donc une correction correspondante de la liste
2) autant d'autres échapperont purement et simplement, ce qui aura alors pour effet, si l'on veut aboutir à une liste saine, de la reprendre quasiment à zéro pour vérifier que les articles non dénoncés (la très grande majorité, donc) ne sont vraiment pas des "doublons en similarité"

Qu'est une telle liste de mots clés ? -->> cela s'appelle un thésaurus. J'ai parlé il n'y a pas très longtemps tant du soin à apporter à la constitution d'un thésaurus que des difficultés ensuite quasiment insurmontables à en corriger ultérieurement les erreurs résultant de précautions et réflexions insuffisantes au départ. Mes remarques dans ce sens ont été sinon mal acceptées, tout au moins mal comprises.

Je vais suivre cette discussion, certes, mais ne vais pas m'en mêler outre mesure.

 

[job75]

Aucune solution de détermination de "similarité" ne sera exempte de failles.

Oui et mes solutions n'y échappent pas : j'ai traité seulement le cas où un caractère est supprimé, pas le cas où un caractère est remplacé par un autre.

 

[job75]

Alors maintenant je traite aussi le remplacement des caractères.

Dans ce fichier (2) la macro résout donc complètement le problème posé au #1 :

Sub Compare()
Dim t, CollectLigne As New Collection, tablo, resu(), i&, x$, j%, y$, car$, k%, c$
t = Timer
On Error Resume Next
With [A1].CurrentRegion
    tablo = .Resize(, 2) 'matrice plus rapide, au moins 2 éléments
    ReDim resu(1 To UBound(tablo), 1 To 1)
    '---collection des textes réduits ou remplacés---
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        For j = 1 To Len(x)
            y = Left(x, j - 1) & Mid(x, j + 1) 'texte réduit de 1 caractère
            CollectLigne.Add i, y 'mémorise la ligne
        Next j
        For j = 1 To Len(x)
            car = LCase(Mid(x, j, 1))
            For k = 32 To 255
                c = LCase(Chr(k))
                If c <> car Then
                    y = Left(x, j - 1) & c & Mid(x, j + 1) 'texte avec 1 caractère remplacé
                    CollectLigne.Add i, y 'mémorise la ligne
                End If
    Next k, j, i
    '---remplissage de resu---
    resu(1, 1) = "Ligne similaire"
    For i = 2 To UBound(tablo)
        resu(i, 1) = CollectLigne(tablo(i, 1))
    Next i
    '---restitution---
    .AutoFilter: .AutoFilter 'si le tableau est filtré
    .Columns(2) = resu
End With
MsgBox "Durée des calculs " & Format(Timer - t, "0.00") & " secondes" & vbLf & vbLf _
    & "Une collection de " & Format(CollectLigne.Count, "#,##0") & " éléments a été étudiée..."
End Sub

La durée d'exécution est de 19 secondes chez moi.

 

[job75]

Un bémol : je ne comprends pas pourquoi la ligne 287 donne ce résultat.

Bonne nuit.

 

[job75]

Bonjour le fil, le forum,

Un bémol : je ne comprends pas pourquoi la ligne 287 donne ce résultat.

En fait c'est simple : la valeur de la date en A287 est 44146 et CollectLigne(tablo(i, 1)) renvoyait la valeur du 44146ème élément créé soit 32.

C'est corrigé dans ce fichier (3) en prenant la valeur texte ("11/11/2020") mais de toute façon les résultats ne sont pas satisfaisants pour A287, A339, A749 etc... où la ligne similaire est la même ligne.

Il s'agit des cellules contenant des chiffres et je ne vois pas comment corriger cela.

Bonne journée.