Macro Excel ou VBA

Le 05/12/2020 à 17:13

Bonjour,

Depuis plusieurs jours je bute sur une difficulté qui va au delà de mes compétences sur Excel

J'ai un classeur qui est composé de 27 feuilles pour les 26 premières feuilles (1 pour chacune des lettres de l'alphabet) j'ai 20 colonnes fixes

et j'ai un nombre variable de lignes (de plusieurs centaines à plusieurs milliers) la 27ème feuille est une table de correspondance entre des caractères utf8 et Iso

lorsque ce fichier a été importé il y avait un problème d'encodage et certains caractères sont remplacés exemple é en lieu et place de é ; è en lieu et place de è ...

je souhaiterai pouvoir remplacer dans les cellules concernées ces valeurs erronées par la valeur correspondante dans la table (composée de 2 colonnes et de 111 lignes) en une seule fois est ce possible ?

merci pour vos réponses

Cordialement,

P. RENAUD

Le 05/12/2020 à 17:23

Bonjour

Utilise depuis le menu ACCUEIL Rechercher et Remplacer

Dans rechercher copier/coller les lettres è et dans Remplacer mettre è

dans les options --> Dans mettre Classeur et cliquez sur Remplacer tout

Même opération pour les autres caractères

Le 05/12/2020 à 17:30

Bonjour,

sinon déposer un fichier avec quelques lignes avec le pb
eric

Le 05/12/2020 à 19:16
5test.xlsx (36.40 Ko)

Re-bonjour

Pour mieux me faire comprendre voici un extrait du fichier : est il possible de changer ces caractères erronés (plusieurs milliers dans la base de données) en une seule fois via une macro ?

Merci pour vos réponses

P RENAUD

Le 05/12/2020 à 22:50

Comme c'est une opération potentiellement très longue, j'ai ajouté dans la barre d'état en bas l'avancement : nom feuille:remplacement en cours

7test.xlsm (51.41 Ko)

eric

Le 05/12/2020 à 23:05

Un grand merci pour vous être penché sur ma problématique

cela fonctionne parfaitement

P.RENAUD

Le 05/12/2020 à 23:15

Méfie-toi si tu fais transiter ton fichier par un Mac, tu retrouveras un problème similaire.
eric

Le 05/12/2020 à 23:52

bonjour,

j'ai rien compris,mais voila un code VBA qui converti UTF8 en ISO et Iso en UTF8!

Sub main()
    Debug.Print Encode_UTF8("?")
    Debug.Print Decode_UTF8(Encode_UTF8("?"))
    Debug.Print Decode_UTF8("éa")
    Debug.Print isUTF8("éa")
    Debug.Print isUTF8("abcde")
    Debug.Print Encode_UTF8("abcdeééàê")
    Debug.Print Decode_UTF8(Encode_UTF8("abcdeééàê"))
End Sub
'   Char. number range  |        UTF-8 octet sequence
'      (hexadecimal)    |              (binary)
' --------------------+---------------------------------------------
'   0000 0000-0000 007F | 0xxxxxxx
'   0000 0080-0000 07FF | 110xxxxx 10xxxxxx
'   0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx
'   0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
Public Function Encode_UTF8(astr)
    Dim c
    Dim n
    Dim utftext

    utftext = ""
    n = 1
    Do While n <= Len(astr)
        c = AscW(Mid(astr, n, 1))
        If c < 128 Then
            utftext = utftext + Chr(c)
        ElseIf ((c >= 128) And (c < 2048)) Then
            utftext = utftext + Chr(((c \ 64) Or 192))
            utftext = utftext + Chr(((c And 63) Or 128))
        ElseIf ((c >= 2048) And (c < 65536)) Then
            utftext = utftext + Chr(((c \ 4096) Or 224))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        Else ' c >= 65536
            utftext = utftext + Chr(((c \ 262144) Or 240))
            utftext = utftext + Chr(((((c \ 4096) And 63)) Or 128))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        End If
        n = n + 1
    Loop
    Encode_UTF8 = utftext
End Function

'   Char. number range  |        UTF-8 octet sequence
'      (hexadecimal)    |              (binary)
' --------------------+---------------------------------------------
'   0000 0000-0000 007F | 0xxxxxxx
'   0000 0080-0000 07FF | 110xxxxx 10xxxxxx
'   0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx
'   0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
Public Function Decode_UTF8(astr)
    Dim c0, c1, c2, c3
    Dim n
    Dim unitext

    If isUTF8(astr) = False Then
        Decode_UTF8 = astr
        Exit Function
    End If

    unitext = ""
    n = 1
    Do While n <= Len(astr)
        c0 = Asc(Mid(astr, n, 1))
        If n <= Len(astr) - 1 Then
            c1 = Asc(Mid(astr, n + 1, 1))
        Else
            c1 = 0
        End If
        If n <= Len(astr) - 2 Then
            c2 = Asc(Mid(astr, n + 2, 1))
        Else
            c2 = 0
        End If
        If n <= Len(astr) - 3 Then
            c3 = Asc(Mid(astr, n + 3, 1))
        Else
            c3 = 0
        End If

        If (c0 And 240) = 240 And (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 240) * 65536 + (c1 - 128) * 4096) + (c2 - 128) * 64 + (c3 - 128)
            n = n + 4
        ElseIf (c0 And 224) = 224 And (c1 And 128) = 128 And (c2 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 224) * 4096 + (c1 - 128) * 64 + (c2 - 128))
            n = n + 3
        ElseIf (c0 And 192) = 192 And (c1 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 192) * 64 + (c1 - 128))
            n = n + 2
        ElseIf (c0 And 128) = 128 Then
            unitext = unitext + ChrW(c0 And 127)
            n = n + 1
        Else ' c0 < 128
            unitext = unitext + ChrW(c0)
            n = n + 1
        End If
    Loop

    Decode_UTF8 = unitext
End Function

'   Char. number range  |        UTF-8 octet sequence
'      (hexadecimal)    |              (binary)
' --------------------+---------------------------------------------
'   0000 0000-0000 007F | 0xxxxxxx
'   0000 0080-0000 07FF | 110xxxxx 10xxxxxx
'   0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx
'   0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
Public Function isUTF8(astr)
    Dim c0, c1, c2, c3
    Dim n

    isUTF8 = True
    n = 1
    Do While n <= Len(astr)
        c0 = Asc(Mid(astr, n, 1))
        If n <= Len(astr) - 1 Then
            c1 = Asc(Mid(astr, n + 1, 1))
        Else
            c1 = 0
        End If
        If n <= Len(astr) - 2 Then
            c2 = Asc(Mid(astr, n + 2, 1))
        Else
            c2 = 0
        End If
        If n <= Len(astr) - 3 Then
            c3 = Asc(Mid(astr, n + 3, 1))
        Else
            c3 = 0
        End If

        If (c0 And 240) = 240 Then
            If (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
                n = n + 4
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 224) = 224 Then
            If (c1 And 128) = 128 And (c2 And 128) = 128 Then
                n = n + 3
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 192) = 192 Then
            If (c1 And 128) = 128 Then
                n = n + 2
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 128) = 0 Then
            n = n + 1
        Else
            isUTF8 = False
            Exit Function
        End If
    Loop
End Function
9test-3.xlsm (53.73 Ko)
Le 06/12/2020 à 09:17

Bonjour…

«est il possible de changer ces caractères erronés (plusieurs milliers dans la base de données) en une seule fois via une macro ?»

Tu récupères les informations feuille par feuille donc tu fractionneras la durée (qui peut durer, durer… sur la totalité) à chaque activation d'une feuille ainsi, dans ThisWorkbook :

Dim P As Range, R As Range, C As Range
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  If Sh.Name = "Table" Then Exit Sub
  Application.ScreenUpdating = 0 'pas de mise à jour de l'écran à chaque ligne
  Set P = [A1].CurrentRegion
  For Each R In P
   For Each C In [TB]
     If R Like ("*" & C & "*") Then R = Replace(R, C, C(1, 2)): Exit For
   Next
  Next
End Sub
12remplace-par-vba.xlsm (49.51 Ko)

Remarque : j'ai intégré la Table dans un tableau structuré (le bien venu) TB.

Le 06/12/2020 à 10:11

bonjour,

avec le code que j'ai envoyé ça devrait être plus rapide !

  For Each R In P
     R =  Decode_UTF8(R)
Next

j'ai pas regardé, mais les données provinne d'un import CSV ?

Rechercher des sujets similaires à "macro vba"