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

libellule85 · 4 Mars 2017

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 :

VB:

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 · 4 Mars 2017

Bonjour, libellule85, le Forum,

En attendant mieux...

VB:

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 · 4 Mars 2017

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

DoubleZero · 4 Mars 2017

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 :

VB:

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 · 4 Mars 2017

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

VB:

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

mais avec les deux cellules F1 et G1 à modifier ?

DoubleZero · 4 Mars 2017

Re-bonjour,

libellule85 à dit:
...Je suis nulle en vba...

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

libellule85 à dit:
...peut-on mettre quelque chose du style :

VB:

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 · 4 Mars 2017

Re,
Pas de problème ci-joint

DoubleZero · 4 Mars 2017

Re-bonjour,

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

VB:

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 · 5 Mars 2017

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 :

Code:

=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

VB:

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 · 5 Mars 2017

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 · 5 Mars 2017

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

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

libellule85 · 10 Mars 2017

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 · 10 Mars 2017

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 · 10 Mars 2017

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

libellule85 · 11 Mars 2017

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

VB:

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

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

libellule85

XLDnaute Accro

DoubleZero

XLDnaute Barbatruc

libellule85

XLDnaute Accro

DoubleZero

XLDnaute Barbatruc

libellule85

XLDnaute Accro

DoubleZero

XLDnaute Barbatruc

libellule85

XLDnaute Accro

Pièces jointes

DoubleZero

XLDnaute Barbatruc

ODVJ

XLDnaute Impliqué

Roland_M

XLDnaute Barbatruc

Pièces jointes

libellule85

XLDnaute Accro

libellule85

XLDnaute Accro

Pièces jointes

ODVJ

XLDnaute Impliqué

libellule85

XLDnaute Accro

libellule85

XLDnaute Accro

Discussions similaires