[Résolu] Macro évènementielle pour remplacer caractères spéciaux

[libellule85]

Bonjour le forum,

j'ai récupéré dans un open data une bdd, par contre toutes les lettres ayant des accents apparaissent avec è pour le é.
J'ai fait une macro par l'intermédiaire de l'enregistreur et cela me donne ceci :

Sub Macro1()
'    'Range("A1065").Select
    'ActiveCell.FormulaR1C1 = "34 - Hérault"
    Cells.Replace What:="[B]è[/B]", Replacement:="[B]è[/B]", LookAt _
        :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

Donc pour chaque voyelles particulières je suis obligée de coller à chaque fois le caractère spécial ainsi que son correspondant "normal" !
Je voulais donc savoir, s'il n'était pas possible de faire une macro événementielle (en F1 le caractère spécial à remplacer et en G1 le bon caractère) qui se déclenche après renseignement de la deuxième cellule (G1) ?
D'avance merci pour votre aide.

 

[DoubleZero]

Bonjour, libellule85, le Forum,

En attendant mieux...

Option Explicit
Sub Caractères_spéciaux_remplacer()
    On Error Resume Next
    With Cells
    ' valeurs adapter
        .Replace What:="è", Replacement:="è", LookAt:=xlPart
        .Replace What:="&#239", Replacement:="ï", LookAt:=xlPart
        .Replace What:="&#233", Replacement:="é", LookAt:=xlPart
        .Replace What:=";", Replacement:="", LookAt:=xlPart
        .Replace What:="&#224", Replacement:="à", LookAt:=xlPart
    End With
End Sub

A bientôt

 

[libellule85]

Bonjour DoubleZero,
Un grand merci pour ta réponse.

 

[DoubleZero]

Re-bonjour,

Après avoir sollicité la macro suggérée en #2 , peut-être serait-il préférable d'insérer, dans le module de l'onglet de travail, l'événementielle suivante :

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal c As Range)
    Application.ScreenUpdating = False
    Call Caractères_spéciaux_remplacer
    Application.ScreenUpdating = True
End Sub

A bientôt

 

[libellule85]

Re DoubleZero,
Je suis nulle en vba mais peut-on mettre quelque chose du style :

If Not Application.Intersect(Target, Range("G1")) Is Nothing Then
call.....

mais avec les deux cellules F1 et G1 à modifier ?

 

[DoubleZero]

Re-bonjour,

...Je suis nulle en vba...

Qu'importe ! Toi et moi sommes là pour apprendre

...peut-on mettre quelque chose du style :

If Not Application.Intersect(Target, Range("G1")) Is Nothing Then
call.....

...mais avec les deux cellules F1 et G1 à modifier ?

Pourrais-tu, s'il te plaît, déposer un fichier exemple ?

A bientôt

 

[libellule85]

Re,
Pas de problème ci-joint

 

[DoubleZero]

Re-bonjour,

Je regrette de ne savoir suggérer d'autre code que...

Option Explicit
Sub Caractères_spéciaux_remplacer_v2()
    On Error Resume Next
    With Cells
        ' valeurs adapter et(ou) compléter
        .Replace What:="é", Replacement:="é", LookAt:=xlPart
        .Replace What:="â", Replacement:="â", LookAt:=xlPart
        .Replace What:="ç", Replacement:="ç", LookAt:=xlPart
        .Replace What:="ô", Replacement:="ô", LookAt:=xlPart
        .Replace What:="è", Replacement:="è", LookAt:=xlPart
        .Replace What:="É", Replacement:="E", LookAt:=xlPart
        .Replace What:="ê", Replacement:="ê", LookAt:=xlPart
        .Replace What:="ë", Replacement:="ë", LookAt:=xlPart
        .Replace What:="û", Replacement:="û", LookAt:=xlPart
    End With
    Columns.AutoFit
End Sub

A bientôt

 

[ODVJ]

Bonsoir à tous,

Petite info : il suffit d'ajouter 64 au code ascii du caractère qui suit à pour obtenir le caractère kivabien.
Pour ceux qui ont Morefunc de Laurent Longre, cette formule fait le job :

=REGEX.SUBSTITUE(B2;"Ã(.)";"=CHAR(CODE(""[1]"")+64)")

Il faut ensuite faire un Copier/Collage spécial pour ne garder que le résultat.

Il est facile de passer par une macro pour faire la même chose.
L'intérêt est de ne pas avoir à identifier tous les caractères susceptibles de se trouver après le Ã.

Cordialement

edit : voilà un code possible

Sub A_tilde()
    Dim Bassins
    Dim c$, i%, j%
    Bassins = [Bassins_de_vie].Value
    n = UBound(Bassins)
    For i = 1 To n
        If Bassins(i, 1) Like "*Ã*" Then
            c$ = ""
            For j = 1 To Len(Bassins(i, 1))
                If Mid(Bassins(i, 1), j, 1) = "Ã" Then
                    j = j + 1
                    c$ = c$ & Chr(Asc(Mid(Bassins(i, 1), j, 1)) + 64)
                Else
                    c$ = c$ & Mid(Bassins(i, 1), j, 1)
                End If
            Next j
            Bassins(i, 1) = c$
        End If
    Next i
    [G2].Resize(n, 1) = Bassins
End Sub

 

[Roland_M]

Bien le bonjour tout le monde,

Salut DoubleZero, ODVJ

pour te faciliter la vie, voir ton classeur avec adaptation de la macro de ODVJ

 

[libellule85]

Bonjour tout le monde,
Merci beaucoup DoubleZero, ODVJ, Roland_M pour vos réponses.

Edit : ODVJ ta formule est géniale !!!

 

[libellule85]

Bonsoir tout le monde,
ODVJ je reviens vers toi concernant ta macro pour l'adapter à plusieurs colonnes (je ne sais pas comment faire) :

C4 Prénom
D4 Mandat
E4 Circonscription
F4 Département
G4 Candidat-e parrainée
H4 date de Publication

J'aimerais que le résultat des colonnes de C4 à G4 soit recopié à partir de la colonne J il y a plus de 9000 lignes !!
Je t'ai mis un petit fichier exemple.
D'avance je te remercie pour ton aide..

 

[ODVJ]

Bonsoir,

Désolé, mais je suis sans PC pendant 10 jours. Je ne peux rien pour toi pendant ce délai.
Je pense que Roland_M ou DoubleZero (ou d'autres...) te sortiront d'affaire. L'adaptation n'est pas trop compliquée.

Cordialement

 

[libellule85]

Ce n'est pas grave, merci quand même..

 

[libellule85]

Bonjour le forum,
J'ai trouvé sur le forum Excel-Pratique un code qui fonctionne impeccable sur mon fichier, merci beaucoup cousinhub !

Sub remplace_csv() 'cousinhub
ReDim A_Remplacer(0 To 10000)
ReDim Remplacants(0 To 10000)
Dim I As Byte
A_Remplacer = Array("î", "é", "→", "Ü", "ù", "â", "è", "à ", "’", "€", "®", "Ø", "°", "ç", "ô", _
                  "«", "»", "û", "ê", "…", "/ø", "ø", "À", "É", "È", " à ", "Ö")
Remplacants = Array("î", "é", Chr(26), "Ü", "û", "â", "è", "à", "'", "€", "®", "Ø", "°", "ç", "ô", _
                  Chr(34), Chr(34), "û", "ê", "..", "ø", "ø", "A", "E", "E", " à ", "Ö")
For I = 0 To UBound(A_Remplacer)
    Cells.Replace What:=A_Remplacer(I), Replacement:=Remplacants(I), LookAt:=xlPart
Next I
End Sub