Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL pour MAC Surligner les mots similaire dans une liste

arico55

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

jmfmarques

XLDnaute Accro
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

XLDnaute Barbatruc
Bonjour à tous,

Un début de piste par MFC
VB:
=NB.SI($A$2:$A$2725;$A2&"*")>1

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

JHA
 

Pièces jointes

  • mots.xls
    133 KB · Affichages: 3

job75

XLDnaute Barbatruc
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 :
VB:
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+
 

Pièces jointes

  • mots(1).xls
    250 KB · Affichages: 5
Dernière édition:

job75

XLDnaute Barbatruc
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;;
 

Pièces jointes

  • mots par formules(1).zip
    673.2 KB · Affichages: 3
Dernière édition:

jmfmarques

XLDnaute Accro
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

XLDnaute Barbatruc
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 :
VB:
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.
 

Pièces jointes

  • mots(2).xls
    253.5 KB · Affichages: 6

job75

XLDnaute Barbatruc
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.
 

Pièces jointes

  • mots(3).xls
    275 KB · Affichages: 3

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…