Discussion :

[T0n10]

Bonjour à tous,

Je souhaiterais vous exposer une problématique pour laquelle je ne trouve pas de solution ou en tout cas à déterminer par quel bout prendre ce problème.

Comme l'indique le titre il s'agirait de faire un InStr avec des caractères génériques

Ma question est très simple,
- J'ai une chaine de caractère dans une 1ere colonne qui a la forme suivante xxx-yyy-zzzz (cette chaine de caractère est unique dans cette cellule).
- Je souhaiterais savoir si cette chaine de caractère existe dans une seconde colonne.
SAUF QUE :
-> Il s'avère que pour des problèmes de saisies la seconde chaine peut ressembler à cela xxx_yyy_zzzz
-> Cette seconde chaine de caractère peur être "noyée" dans une chaine contenant plusieurs références.

Donc peut-on poser la question suivante ? "Existe-t-il dans la seconde colonne une chaine de type xxx?yyy?zzzz comme dans la première colonne ?"

Aujourd'hui j'ai un code qui fonctionne qui ressemble à ca (je trouve pas de balise <code> )

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
If (InStr(1, Cells(i, 2).Value, Cells(i2, 1).Value)) > 0 Then
...
End If

Cela fonctionne mais fait de la correspondance exacte. Se posera pas dessus la question le problème lié au fait que je travaille sur des objets de type Cells.Value et non les chaine de caractères a proprement parlé mais chaque chose en son temps

J'ai commencé à faire des recherches à base de LIKE mais sans résultat véritablement convaincant.

J'espère avoir été clair.
Je vous remercie pour votre aide.

Tonio

[Marc-L]

Bonjour,

utiliser par exemple l'opérateur Like documenté dans l'aide VBA interne …



______________________________________________________________________________________________________
Je suis Paris, Charlie, …

[Docmarti]

Bonjour.

La suggestion de Marc est très intéressante:

Démo :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Demo_Like()
 
Cells(1, 1) = "xxx-yyy-zzzz"
Cells(1, 2) = "123xxx_yyy_zzzz456"
 
aa = Replace(Cells(1, 1), "-", "?")
aa = "*" & aa & "*"
 
Result = Cells(1, 2) Like aa
If Result = True Then
 MsgBox "Vrai"
End If
 
End Sub

[patricktoulon]

Bonsoir
ne pouvant pas gérer par rapport a des problèmes de saisie d'après ce que j ai compris
avant de faire ta recherche tu pourrais normaliser toutes les cellules concernée et les mettre toute au même format en moins de deux
exemple adapte ta plage
elles auront toute le même format même celles qui sont noyées dans une chaine

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub formatage()
Dim i As Long, Txt As String, Txt2 As String
  For each cel in range("A1:B200")
    Txt =cel.value
    With CreateObject("VBScript.RegExp")
      .Global = True
      '.IgnoreCase = True
      .Pattern = "[^\w]"
      Txt2 = .Replace(Txt, "-")
    End With
    Cel.lValue = Txt2
  Next i
End Sub

[T0n10]

Bonjour,

Merci pour vos retours

@Docmarty : L'idée est effectivement interessante mais je ne vois pas comment la mettre en oeuvre.

En effet, cela revient pour moi à faire le test suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
If "xxx-yyy-zzzz" like "xxx?yyy?zzzz, xxx1?yyy1?zzzz1?, xxx2?yyy2?zzzz2?, xxx3?yyy3?zzzz3?" then
MsgBox "Vrai"
End If

Et cela ne me retourne jamais vrai car il manque la notion "InString"

Mais la fonction ci dessous fonctionne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
If "xxx-yyy-zzzz" like "xxx?yyy?zzzz"
MsgBox "Vrai"
End If

@Patrick. Effectivement l'idée d'uniformiser peut être la solution, mais l'idée pour l'instant est de ne pas modifier les données sources (impacts en cascade ....)

Pour l'instant, je continue d'investiguer et d'essayer de répondre à la question pourtant simple : existe-t-il une chaine de la forme xxx?yyy?zzzz dans une autre chaine plus grande ?

Petite question, mais gros probleme

Merci à vous.
Tonio

[Invité]

Bonjour,
voila ce que me donne l'enregistreur de macro!

tu peux t'inspirer de ça!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub Macro1()
'
' Macro1 Macro
'
 
'
    Cells.Find(What:="*zz*", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
End Sub

[patricktoulon]

une question importante

dans la colonne de référence les chaines sont elles noyées aussi ??

[T0n10]

Bonjour,

@rdurupt : Merci je vais regarder ce côté là

@Patrick : Non, la colonne "source" comporte les references unitairement dans chaque cellule. C'est la colonne "propre".
Dans l'autre ce sont des concaténations issues d'excel créées par des personnes, avec les infos ecrites parfois à la main (avec les coquilles du genre "-" à la place de "_" etc.). Parfois les references sont séparés par une virgules d'autres par des retour charriot ... Le InStr est tres bon pour ce genre de cas mais trop limité ici

Tonio

[patricktoulon]

c'est pour ca que je t'ai proposer le regular expression pour formater
maintenant si tu ne veux pas formater les cellules tu peut formater l'argument du instr
exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
For a = 1 To Cells(Rows.Count, 1).End(xlUp).Row
chaine1 = texteformaté(Cells(a, 1).Text)
For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row + 1
chaine2 = texteformaté(Cells(i, 2).Text)
If InStr(chaine1, chaine2) > 0 Then texte = texte & "A" & a & "  est egale a  " & "b" & i & vbCrLf: Exit For
Next
Next
MsgBox texte
End Sub
Function texteformaté(mot As String) As String
texteformaté = Replace(Replace(Replace(Replace(Replace(mot, "_", "*"), "-", "*"), "?", "*"), ",", "*"), ".", "*")
'Debug.Print Replace(Replace(Replace(Replace(Replace(mot, "_", "*"), "-", "*"), "?", "*"), ",", "*"), ".", "*")
End Function

[patricktoulon]

re avec like il n'y a pas de raté meme avec les noyées

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
For a = 1 To Cells(Rows.Count, 1).End(xlUp).Row
chaine1 = texteformaté(Cells(a, 1).Text)
For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row
chaine2 = texteformaté(Cells(i, 2).Text)
If chaine2 Like chaine1 Then texte = texte & "A" & a & "  est egale a  " & "b" & i & vbCrLf ': Exit For
Next
Next
MsgBox texte
End Sub
Function texteformaté(mot As String) As String
texteformaté = Replace(Replace(Replace(Replace(Replace(mot, "_", "*"), "-", "*"), "?", "*"), ",", "*"), ".", "*")
'Debug.Print Replace(Replace(Replace(Replace(Replace(mot, "_", "*"), "-", "*"), "?", "*"), ",", "*"), ".", "*")
End Function

[patricktoulon]

et pour le plus du plus tes cellules identiques sont coloriées

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub test()
Randomize
For a = 1 To Cells(Rows.Count, 1).End(xlUp).Row
couleur = (Rnd * 56)
chaine1 = texteformaté(Cells(a, 1).Text)
For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row
chaine2 = texteformaté(Cells(i, 2).Text)
If chaine2 Like chaine1 Then texte = texte & "A" & a & "  est egale a  " & "b" & i & vbCrLf ': Exit For
If chaine2 Like chaine1 Then
Cells(a, 1).Interior.ColorIndex = couleur
Cells(i, 2).Interior.ColorIndex = couleur
End If
Next
Next
MsgBox texte
End Sub
Function texteformaté(mot As String) As String
texteformaté = Replace(Replace(Replace(Replace(Replace(mot, "_", "*"), "-", "*"), "?", "*"), ",", "*"), ".", "*")
'Debug.Print Replace(Replace(Replace(Replace(Replace(mot, "_", "*"), "-", "*"), "?", "*"), ",", "*"), ".", "*")
End Function

[T0n10]

Patrick t'es trop fort ^^

Ca marche presque parfaitement. Le truc bien en plus c'est que je fais ca derriere :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
For i = 2 To Dernligne_Req_CCB
 
Req_CCB = Replace(Cells(i, 2).Value, "-", "?")
Req_CCB = Replace(Req_CCB, "_", "?")
 
    For i2 = 2 To Dernligne_Req_Perimetre
 
    Req_Perimetre = Replace(Cells(i2, 1).Value, "-", "?")
    Req_Perimetre = Replace(Req_Perimetre, "_", "?")
 
        If (InStr(1, Req_CCB, Req_Perimetre)) > 0 Then
            First_car = InStr(1, Req_CCB, Req_Perimetre
            With Cells(i, 2).Characters(Start:=First_car, Length:=Len(Cells(i2, 1).Value))
                .Font.Bold = True
                .Font.Color = RGB(0, 255, 0)
            End With
        End If
 
    Next i2
 
Next i

C'est a dire, que comme je conserve le InStr, je conserve la position de la chaine
Du coup je peux toujours mettre en vert / gras la chaine quand il la trouve. Bon seul hic, j'en ai identifié quelques uns qui passent au travers. Je vais voir pourquoi, mais on y est presque grace à toi

Merci beaucoup

Tonio

[T0n10]

C'est bon, c'est corrigé

Merci un milliard de fois Patrick

Au plaisir de se croiser sur Toulon

Tonio

[patricktoulon]

oui les moyées passe a travers je n'arrive pas a mètre l'inconnu"*" dans le like avec la variable chaineX
normalement on fait
if chaine2 like "*toto*" then ......les deux Etoiles représente quelque chose qui pourrait se trouver devant ou derrière ou pas

maintenant si j'ai
chaine1=toto
if chaine2 like "*" & chaine1 & "*" ca ne fonctionne pas
je vais voir si je compile la chaine avec inconnu avant ca ne fonctionne pas ?, j'y avais pas penser!!!

[T0n10]

Ma fonction est la suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub Controle_Req()
 
Dim Dernligne_Req_Perimetre, Dernligne_Req_BBC As Long
Dim i, i2, First_car As Integer
Dim Req_Perimetre, Req_BBC As String
 
Dernligne_Req_Perimetre = Range("A" & Rows.Count).End(xlUp).Row
Dernligne_Req_BBC = Range("b" & Rows.Count).End(xlUp).Row
 
 
For i = 2 To Dernligne_Req_BBC
 
Req_BBC = Replace(Cells(i, 2).Value, "-", "?")
Req_BBC = Replace(Req_BBC, "_", "?")
 
    For i2 = 2 To Dernligne_Req_Perimetre
 
    Req_Perimetre = Replace(Cells(i2, 1).Value, "-", "?")
    Req_Perimetre = Replace(Req_Perimetre, "_", "?")
 
        If (InStr(1, Req_BBC, Req_Perimetre)) > 0 Then
            First_car = InStr(1, Req_BBC, Req_Perimetre)
            ' MsgBox First_car
            With Cells(i, 2).Characters(Start:=First_car, Length:=Len(Req_Perimetre))
                .Font.Bold = True
                .Font.Color = RGB(0, 255, 0)
            End With
        End If
 
    Next i2
 
Next i

Elle semble fonctionner niquel ... tu vois une faille ?

[patricktoulon]

chez moi le résultat est faux presque toute la colonne B est verte

tiens celui la il est parfait on applique les deux test (instr/like)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub test()
    Randomize
    For a = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        couleur = (Rnd * 56)
        chaine1 = texteformaté(Cells(a, 1).Text)
        For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row
            If chaine1 <> "" Then
 
                chaine2 = texteformaté(Cells(i, 2).Text)
                If chaine2 Like chaine1 Then texte = texte & "A" & a & "  est egale a  " & "b" & i & vbCrLf    ': Exit For
                If chaine2 Like chaine1 > 0 Then
                    Cells(a, 1).Font.ColorIndex = couleur
                    Cells(i, 2).Font.ColorIndex = couleur
                    Cells(i, 2).Font.Bold = True
 
                End If
                If InStr(chaine2, chaine1) > 0 Then
 
 
                    Cells(a, 1).Font.ColorIndex = couleur
                    Cells(i, 2).Font.ColorIndex = couleur
                    Cells(i, 2).Font.Bold = True
 
                End If
            End If
        Next
    Next
    MsgBox texte
End Sub
Function texteformaté(mot As String) As String
    texteformaté = LCase(Replace(Replace(Replace(Replace(Replace(mot, "_", "*"), "-", "*"), "?", "*"), ",", "*"), ".", "*"))
    'Debug.Print Replace(Replace(Replace(Replace(Replace(mot, "_", "*"), "-", "*"), "?", "*"), ",", "*"), ".", "*")
End Function

[patricktoulon]

alors la on voit bien qu'après un petit café les neurones reviennent a fond
je te propose un test encore plus simple qui réuni le instr/like avec les variantes de chaines noyées ou pas en un seul test très simple

il se trouve que si tu fait un replace dans la chaine2 avec la chaine1 et que le len la chaine2 change ca veut dire que la chaine 1 s'y trouve ou quelle soit (pour les noyées)
donc voila the perfect!!!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub test2()
    Randomize
    For a = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        couleur = (Rnd * 52) + 4
        chaine1 = texteformaté(Cells(a, 1).Text)
        For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row
             If chaine1 <> "" Then
                chaine2 = texteformaté(Cells(i, 2).Text)
                If Len(Replace(chaine2, chaine1, "")) <> Len(chaine2) Then ' on ne fait que ce test !!!!! et ca suffit 
                   texte = texte & "A" & a & "  est egale a  " & "b" & i & vbCrLf    ': Exit For
                    Cells(a, 1).Font.ColorIndex = couleur
                    Cells(a, 1).Font.Bold = True
                    Cells(i, 2).Font.ColorIndex = couleur
                    Cells(i, 2).Font.Bold = True
                End If
            End If
        Next
    Next
    MsgBox texte
End Sub
Function texteformaté(mot As String) As String
    texteformaté = LCase(Replace(Replace(Replace(Replace(Replace(mot, "_", "*"), "-", "*"), "?", "*"), ",", "*"), ".", "*"))
    'Debug.Print Replace(Replace(Replace(Replace(Replace(mot, "_", "*"), "-", "*"), "?", "*"), ",", "*"), ".", "*")
End Function

des fois je suis bête je cherche tellement a traficoter dans la mécanique que je ne vois pas ce qui est simple LOL

[T0n10]

chez moi le résultat est faux presque toute la colonne B est verte

Ah ? Ton fichier source m’intéresse du coup ...

Viens de refaire un test rapide chez moi avec des chaines au pif et ça fonctionne



Et je suis tout fait d'accord avec ta dernière remarque. La fonction Instr "initiale" fonctionnait très bien, sauf que ca faisait des correspondance exacte. Ton conseil de normaliser toutes les cellules était la bonne solution mais on continue de se creuser la tête ... alors qu'il "suffisait" de passer par variable interposée afin de ne pas toucher aux données sources.

J'irais même plus loin, on aurait tout a fait pu faire (dans mon code) et pour les deux variables

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Req_BBC = Replace(Cells(i, 2).Value, "-", "Mon_nom_est_roger")
Req_BBC = Replace(Req_BBC, "_", "Mon_nom_est_roger")

que ça marchait aussi bien tant que c'était normaliser

Edit : Bon je sais pas pourquoi il reste cette deuxième image ... elle n'apparait pourtant pas dans l’édition de code

[T0n10]

Bon je refais un bon screenshot les autres au dessus sont nulles.




On voit bien que les "-" et "_" sont ignorés

[patricktoulon]

teste la derniere solution the perfect !!!


il n'y a pas d'erreur ni de manque possible ne va pas chercher plus loin apres oui comme tu veux intergre la méthode dans code si tu veux
mon fichier source je ne l'ai plus c'était pour toi que je l'avais fait

une fois la solution la plus probante trouvé et donné je vire les fichiers

donc conclusion la methode la plus performante c'est le test du len(chaine)