Discussion :

[nonohzx]

Bonjour à tous

Je reviens vers vous aujourd'hui car j'ai un problème avec les accents ><
J'ai un fichier excel contenant un listing ou la moitié des informations sont rentrées à la main et souvent n'importe comment ... Malheureusement pour moi je dois affecter une valeur en fonction du contenu de la ligne (en fait un budget en fonction du type de dépense). On peut régler facilement le problème de la correspondance Majuscule/minuscule (ucase) mais reste le problème de la présence d'accent (ou non), pour faire simple il suffirai de tous les retirer. J'ai trouvé la macro qui traîne sur internet, la fonction qui permet a chaque fois que l'on rentre une lettre avec accent elle est automatiquement remplacée par la même lettre sans accent. Je ne m'y connais pas en fonction vba :/ et quand je copie le code de cette fonction elle ne marche même pas chez moi j'ai bien essayer de bidouiller la fonction sans succès :/

Je cherche donc une macro me permettant de remplacer les lettres avec accent avec les mêmes lettres sans accent, a chaque lancement du programme et sur certaines feuilles (les 2 premières en fait).

Merci d'avance de votre aide

[mercatog]

Ci joint une fonction (à adapter) qui permet de parcourir les lettres d'un mot et de remplacer celles accentuées.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Function ReplAccen(ByVal Str As String) As String
Const AvecAcc As String = "àâéèêuüùîïô"
Const SansAcc As String = "aaeeeuuuiio"
Dim i As Integer, n As Integer
 
If Len(Str) > 0 Then
    For i = 1 To Len(Str)
        n = InStr(AvecAcc, Mid(Str, i, 1))
        If n > 0 Then Mid(Str, i, 1) = Mid(SansAcc, n, 1)
    Next i
End If
ReplAccen = UCase(Str)
End Function

Pour remplacer les données de A1:A1000 de Feuil1

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Sub Remp()
Dim i As Long
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    For i = 1 To 1000
        .Cells(i, 1).Value = ReplAccen(.Cells(i, 1).Value)
    Next i
End With
End Sub

[nonohzx]

Merci a vous 2.
BlueMonkey ta solution est bonne je n'en doute pas mais je souhaitais le faire a chaque démarrage car j'ai déjà plusieurs centaines de ligne ce qui me contraindrait a faire toutes les cellules 1 par 1 :/ de plus certaines informations sont extraites par requête sql ou par une autre macro d'un autre fichier.
Une petite question a part Mercatog : a quoi sert le "." que tu mets avant le "Cells" ? j'en mets quelques fois quand je suis sur de moi mais dans ce cas je ne comprends pas (je ne suis pas (encore) un pro du vba désolé :/).

[mercatog]

Compare les 2 codes suivants, ils sont identiques

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub Remp1()
Dim i As Long
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    For i = 1 To 1000
        .Cells(i, 1).Value = ReplAccen(.Cells(i, 1).Value)
    Next i
End With
End Sub

Code :

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

1
2
3
4
5
6
7
8
Sub Remp2()
Dim i As Long
 
Application.ScreenUpdating = False
For i = 1 To 1000
    Worksheets("Feuil1").Cells(i, 1).Value = ReplAccen(Worksheets("Feuil1").Cells(i, 1).Value)
Next i
End Sub

[nonohzx]

Très bien merci pour ton explication
Je test le programme dès que possible, samedi soir oblige, une ptite soirée est prévue ! merci et bonne soirée a vous

[nonohzx]

Tout fonctionne très bien merci encore !

[BlueMonkey]

Bonjour,

Pour éviter d'avoir à parcourir toute la feuille à chaque démarrage, une solution est de le faire à chaque changement valeur.
Le code n'est pas beau,
Mais pour un peu plus d'efficacité, les remplacements sont imbriqués.

Code :

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

1
2
3
4
5
6
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim s As String
    Target.Cells(1, 1).Value = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Target.Cells(1, 1).Value, _
        "ô", "o"), "ö", "o"), "ä", "a"), "à", "a"), "ê", "e"), "ë", "e"), "è", "e"), "é", "e"), "ç", "c")
 
End Sub

[Edit : poster sans avoir vu le post de Mercatog. Ca fait une autre idée ]
[Edit 2 : une p'tite amélioration à la fin de la fonction Remp() du post #2 , Application.ScreenUpdating = True