VBA - Colorer données proches
Bonjour,
Petite question ! Savez-vous s'il est possible de colorer des lignes si leurs valeurs sont proches (à quelques caractères près) ?
Par exemple, si j'ai des lignes avec inscrit :
Boisement de feuillus
Boisements de feuillus
Boisement de feiullus
Boisement de feuillis
Qu'Excel soit en mesure de colorer les lignes concernées.
Mais si j'ai :
Boisement
Boisements de conifères
Boisement mixte feuillus - conifères
Alors, il ne me colore rien.
Bonne soirée
A plus tard !
Bonjour
as tu essayés la mise en forme conditionnelle?
Cordialement
salut Jarod,
oui, une MFC, très bonne idée ! mais euh, avec quelle règle de MFC ?
bon, j'reconnais qu'il faut une approche un peu feuillue !
dhany
Bonjour,
Merci de votre aide.
En l'occurrence, une MFC est trop restrictive.
Il y a des milliers de combinaisons possibles. (De ce que je vois, elle ne fonctionne que pour les boisements et encore, seulement sur certains mots ; imaginons l'erreur : Boisetements de feuillus => Elle n'est pas repérée).
Par ailleurs, si j'essaie de la faire fonctionner via un code VBA, c'est pour qu'à chaque fois qu'une ligne est surlignée, je puisse faire apparaître un message signalant une possible erreur à corriger.
Salut Le Drosophile,
alors, voilà un truc complètement empirique qui vaut ce qu'il vaut!
Double-clic sur le mot en colonne [A] pour lequel tu veux une "vérification d'approximation"!
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tSplit1, tSplit2
Dim sData1$, sData2$, iIdx%
'
Cancel = True
Columns(4).Interior.Color = xlNone
If Target = "" Then Exit Sub
sData1 = Target
'
For x = 1 To Range("D" & Rows.Count).End(xlUp).Row
iIdx = 0
sData2 = Cells(x, 4)
tSplit1 = Split(sData1, " ")
tSplit2 = Split(sData2, " ")
If UBound(tSplit1) = UBound(tSplit2) Then
For y = 0 To Len(sData1) - 1
sItem = Mid(sData1, y + 1, 1)
If InStr(Right(sData2, Len(sData2) - IIf(y > Len(sData2), Len(sData2) - 1, y)), sItem) > 0 Then
iIdx = iIdx + 1
End If
Next
End If
If sData1 <> sData2 And _
(Abs((Len(sData2) * 100) / Len(sData1)) >= 90 And Abs((Len(sData2) * 100) / Len(sData1)) <= 110) And _
(100 * iIdx) / Len(sData1) > 50 Then Range("D" & x).Interior.Color = RGB(195, 195, 195)
Next
'
End SubA+
Bonjour,
la meilleure chose à faire est de normaliser les saisies à l'aide d'une validation par liste.
Toute saisie hors liste est bloquée, et tu ne pourras avoir que des libellé corrects et connus. Et tant pis pour les pluriels, il vaut mieux limiter la taille de la liste des libellés autorisés.
Une fois le nettoyage de la base réalisé, la mise en couleur correcte ne sera plus un problème. Et tu éviteras des lenteurs...
eric
Salut Le Drosophile,
Salut l'équipe,
Pour le fun, j'ai "amélioré" (c'est un grand mot, je sais) le fonctionnement de l'IA (autre très grand mot
Comme c'est basé, très "scientifiquement
N'empêche, je suis curieux de voir le résultat sur ton fichier... si tu l'essayes, bien sûr.
Un double-clic sur une donnée en [A] recherche les termes approchants en [D] et les surligne.
A part la rigolade, la remarque très pertinente d'Eriiic
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tSplit1, tSplit2
Dim sData1$, sData2$, iIdx%, iSplit%, iPos%, iPCen%
'
Cancel = True
Columns(4).Interior.Color = xlNone
If Target = "" Then Exit Sub
sData1 = Target
'
For x = 1 To Range("D" & Rows.Count).End(xlUp).Row
iPCent = 0
tSplit1 = Split(Target, " ")
tSplit2 = Split(Cells(x, 4), " ")
If UBound(tSplit1) = UBound(tSplit2) And Target <> Cells(x, 4) Then
For iSplit = 0 To UBound(tSplit1)
iIdx = 0
sData1 = tSplit1(iSplit)
sData2 = tSplit2(iSplit)
For y = 0 To Len(sData1) - 1
sItem = Mid(sData1, y + 1, 1)
iPos = InStr(sData2, sItem)
If iPos > 0 Then
iIdx = iIdx + 1
If Len(sData2) = 1 Then Exit For
If iPos = 1 Or iPos = Len(sData2) Then
sData2 = IIf(iPos = 1, Right(sData2, Len(sData2) - 1), Left(sData2, Len(sData2) - 1))
Else
sData2 = Left(sData2, iPos - 1) & Right(sData2, Len(sData2) - iPos)
End If
End If
Next
sData2 = tSplit2(iSplit)
If (Abs((Len(sData2) * 100) / Len(sData1)) >= 85 And Abs((Len(sData2) * 100) / Len(sData1)) <= 115) And _
((100 * iIdx) / Len(sData1)) > 50 Then iPCent = iPCent + 1
Next
If iPCent = UBound(tSplit1) + 1 Then Range("D" & x).Interior.Color = RGB(195, 195, 195)
End If
Next
'
End SubPour le plaisir du code!
A+
Bonsoir,
La colonne que je cherche à traiter avec ce genre de traitement doit être complétée par différentes personnes, qui ont leur propre manière de rédiger et d'attribuer un intitulé. Certains mettrons du pluriel, d'autres du singulier, les milieux forestiers peuvent être désignés par une multitude de terme, sans compter les différents stades forestiers et leurs éventuel niveau de dégradation, etc. Cela peut s'appliquer à tout ce qui est observé.
Dans un cas comme ça, difficile d'établir la liste des termes utilisés et peu envisageable de valider une liste type que chacun utiliserait.
Merci beaucoup pour les propositions ! J'ai testé à plusieurs reprises le code de curulis57 ; il marche vraiment bien ! (Par contre, il faut double cliquer sur les données d'une colonne (A) pour surligner les données d'une autre colonne
Le mieux ici est finalement de compter sur l'attention de celui qui rempli le tableau, qui devra veiller à ne pas faire d'erreur ! (Ce qui en l'occurrence n'est pas très compliqué).
Bonne fin de soirée,
Merci encore pour cette proposition de code. Dès que j'ai terminé mon document, je vais quand même m'y intéresser pour voir comment il fonctionne il peut être vachement utile dans d'autres situations.
A plus tard !