XL 2016 Comparaison - Ignorer les accents

[Maxime26]

Bonjour a tous ,
je vous sollicite car j'ai une problématique pour laquelle je n'arrive pas a trouver la solution .

Explication du code .

Si le nom d'un pays figure sur la colonne 2 de l'onglet "Feuil2" et que ce dernier figure également colonne 20 de l'onglet "Feuil1" alors la ligne et surligné en orange.

Problématique :

Si sur Feuil1 j'écris Bresil alors qu'en Feuil2 il est écris Brésil la ligne n'est pas surligné.

--
J'ai bien compris qu'il fallait faire appel a une fonction ,j'ai pu en récupérer plusieurs sur internet , mais je ne sais pas comment je suis censé faire appel a elle sur mon code , jusque la mes tentative ce sont soldé pars des échecs .

Merci pour l'aide que vous pourrez m'apporter .

Function ch_sans_accent(ch_characters As Range)
liste_accents = "ÉÈÊËÔéèêëàçùôûïî"
liste_sans_accents = "EEEEOeeeeacuouii"
tempo = ch_characters.Value
For k = 1 To Len(tempo)
        s = InStr(liste_accents, Mid(tempo, k, 1))
        If s > 0 Then Mid(tempo, k, 1) = Mid(liste_sans_accents, s, 1)
Next
ch_sans_accent = tempo
End Function

Sub for1()

Dim i As Integer
Dim j As Integer

For i = 10 To 300
For j = 1 To 150
  
If Cells(i, 20) = Worksheets(2).Cells(j, 2) And Cells(i, 20) <> "" Then
Range(Cells(i, 1), Cells(i, 12)).Interior.Color = RGB(255, 192, 0)   
End If

Next j
Next i

End Sub

 

[mapomme]

Bonjour @Maxime26 ,

Un petit rappel de la charte :

2.5 – La possibilité de joindre des fichiers est donnée sur ce forum. Ne pas hésiter à utiliser cette fonction, tout en veillant à ce que les données soient fictives et donc qu’aucune donnée confidentielle, nominative ne soit dans le fichier.

C'est beaucoup plus facile aux répondeurs de répondre, et comme on dit "on n'attire pas les mouches avec du vinaigre" .

A plus.

 

[patricktoulon]

bonsoir @Maxime26 , @mapomme

@Maxime26
si le principe dans la sub for1 est bien celui que tu veux

Function UnaccentedString(ByVal chaine$)

    Dim With_Accents$, Without_Accents$, Q&, s&

   With_Accents = "éèêëàçùôûïî"

    Without_Accents = "eeeeacuouii"

    For Q = 1 To Len(chaine)

        s = InStr(1, With_Accents, LCase(Mid(chaine, Q, 1)), vbBinaryCompare)
        
        If s > 0 Then Mid(chaine, Q, 1) = Mid(Without_Accents, s, 1)

    Next

    UnaccentedString = chaine

End Function

Sub for1()

    Dim i&, j&, Chain_1$, Chain_2$

    For i = 10 To 300

        For j = 1 To 150

            If Cells(i, 20) <> "" Then

                Chain_1 = UnaccentedString(Cells(i, 20))

                Chain_2 = UnaccentedString(Worksheets(2).Cells(j, 2))

                If Chain_1 = Chain_2 Then

                    Cells(i, 1).Resize(, 12).Interior.Color = RGB(255, 192, 0)

                End If

            End If

        Next j

    Next i

End Sub

 

[Maxime26]

Bonjour @mapomme ,
je te remercie pour ce rappel .

Bonjour @patricktoulon ,
je te remercie pour ton aide , cependant cela ne semble pas fonctionner .

j'ai mis ci-joint le fichier Excel contenant le code .
ps : pour lancer la macro il faut modifier une cellule comprise entre T10:X1000.

Merci pour l'aide que tu pourra m'apporter .

 

[patricktoulon]

ok 2 chose le nom"for1" provoquait un bloquange chez moi
ensuite
comme tu a "é" dans ta liste de pay tout tes "e" match forcement
donc a éviter les simple lettres qua ce soit dans la liste de pays ou ta colonne "t"
de plus tu a ta liste de pays en nom propre il faut donc aussi casser la casse pour tester

voila

 

[job75]

Bonsoir Maxime26, mapomme, patricktoulon,

Si le but est de trouver comme indiqué le nom d'un pays le plus simple est de créer une liste des noms de tous les pays du monde avec et sans accents.

La macro recherchera chaque nom dans les 2 colonnes et colorera la cellule s'il est présent.

A+

 

[Maxime26]

ok 2 chose le nom"for1" provoquait un bloquange chez moi
ensuite
comme tu a "é" dans ta liste de pay tout tes "e" match forcement
donc a éviter les simple lettres qua ce soit dans la liste de pays ou ta colonne "t"
de plus tu a ta liste de pays en nom propre il faut donc aussi casser la casse pour tester

voila

Je te remercie grandement pour ton aide , effectivement ca fonctionne .
Je prendrai du temp demain pour bien comprendre comment fonctionne le code .

Merci encore pour ta précieuse aide et bonne soirée .

 

[dysorthographie]

bonsoir @Maxime26 , @mapomme

@Maxime26
si le principe dans la sub for1 est bien celui que tu veux

Function UnaccentedString(ByVal chaine$)

    Dim With_Accents$, Without_Accents$, Q&, s&

   With_Accents = "éèêëàçùôûïî"

    Without_Accents = "eeeeacuouii"

    For Q = 1 To Len(chaine)

        s = InStr(1, With_Accents, LCase(Mid(chaine, Q, 1)), vbBinaryCompare)
      
        If s > 0 Then Mid(chaine, Q, 1) = Mid(Without_Accents, s, 1)

    Next

    UnaccentedString = chaine

End Function

Sub for1()

    Dim i&, j&, Chain_1$, Chain_2$

    For i = 10 To 300

        For j = 1 To 150

            If Cells(i, 20) <> "" Then

                Chain_1 = UnaccentedString(Cells(i, 20))

                Chain_2 = UnaccentedString(Worksheets(2).Cells(j, 2))

                If Chain_1 = Chain_2 Then

                    Cells(i, 1).Resize(, 12).Interior.Color = RGB(255, 192, 0)

                End If

            End If

        Next j

    Next i

End Sub

Bonjour Patrick!

Function UnaccentedString(T As String) As String
Dim I As Integer
UnaccentedString = LCase(T)
With_Accents = "éèêëàçùôûïî"
Without_Accents = "eeeeacuouii"
For I = 1 To Len(With_Accents)
    UnaccentedString = Replace(UnaccentedString, Mid(With_Accents, I, 1), Mid(Without_Accents, I, 1))
Next
End Function
Sub test()
Debug.Print UnaccentedString("éèêëàçùôûïîÉÈÊËÀÇÙÔÛÏÎ")
End Sub

Édité:
Et bonjour tout le monde

 

[patricktoulon]

Bonjour robert
c'est plus lourd le replace
et tu rappelle la fonction tout du moins sa structure en n'utilisant pas une variable intermédiaire