Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 supprimer caractères spéciaux

david gom

XLDnaute Nouveau
Bonjour je souhaite supprimer les caractères spéciaux autres que a-z sur ce fichier.

Auriez vous une solution ?

Merci à vous
 

Pièces jointes

  • test caractères spéciaux.xlsx
    49 KB · Affichages: 29

Staple1600

XLDnaute Barbatruc
Re, Bonjour Amilo

mapomme m'a fait replongé dans mes archives
Mais moi, je fais dans l'impur
VB:
Function Utf8ToUnicode(strText)
   With CreateObject("ADODB.Stream")
      .Open
      .Charset = "Windows-1252"
      .WriteText strText
      .Position = 0
      .Type = 2
      .Charset = "utf-8"
      Utf8ToUnicode = .ReadText(-1)
      .Close
   End With
End Function
NB: Ne fonctionne que sous Windows.
 

Staple1600

XLDnaute Barbatruc
Re, Bonsoir patricktoulon

Pas chez moi.
Mais de toute façon, ce n'est qu'une fonction spéciale confinement
Et personnellement, j'essaie de choisir les bons paramètres de l'assistant d'importation Texte quand j'importe un fichier Texte
(pour conserver les caractères accentués)

Et surtout la question est résolue pour le demandeur depuis quelques posts
 

Staple1600

XLDnaute Barbatruc
Re

•>patricktoulon
Tu m'as mis le doute, alors j'ai testé sur toute la colonne A
(du fichier d'origine)
Toujours pas d'erreur
VB:
Sub Test_OK() 'XL2K13/32bits-W10/64bits
Dim i&, t, tt
t = Range("A2:A3385").Value
ReDim tt(UBound(t, 1))
For i = LBound(t, 1) To UBound(t, 1)
tt(i) = Utf8ToUnicode(CStr(t(i, 1)))
Next
[C1].Resize(UBound(tt)) = Application.Transpose(tt)
End Sub
 

Staple1600

XLDnaute Barbatruc
Re

•>patricktoulon
Ça fonctionne toujours
VB:
Sub test_bis()
Dim stg, zzz, i%, Bazinga$
stg = Array("NOM1 Marie-Ségolène", "NOM2 BÉRÉNICE", "NOM3 Marie-Ségolène", "NOM4 BÉRÉNICE", "NOM5 Marie-Ségolène", "NOM6 BÉRÉNICE", "NOM7 Marie-Ségolène")
ReDim zzz(UBound(stg))
For i = LBound(stg) To UBound(stg)
zzz(i) = Utf8ToUnicode(CStr(stg(i)))
Next
Bazinga = Join(zzz, Chr(10))
MsgBox Bazinga
End Sub
NB/ Question: pourquoi tu n'es pas passé à W10 ?
 

patricktoulon

XLDnaute Barbatruc
re
parce que je fait parti de ceux qui décident quoi et quand un truc doit être installé, modifié ou supprimer sur mon PC
si tu crois avoir ce pouvoir sur le tiens avec W10 et bien tu es bien naïf
déjà que je pleure misère avec 2013 et 2016 sur le portable
ils sont lent, lent,lent pfiuuuuu!!!! alors W10 là je me tire une balle

pour info c'est pas stable a l'ouverture ca fonctionne 1 fois et a la relance erreur paramètre
 

Staple1600

XLDnaute Barbatruc
Re

Confinement oblige, j'ai encore remis dans le nez dans mes archives.
Il restait la voie des API
(test OK sur XL2K13&W10/64bits)
VB:
Option Explicit
Private Declare Function MultiByteToWideChar Lib "Kernel32" _
    (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "Kernel32" _
    (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Const CP_ACP = 0
Const CP_UTF8 = 65001
Public Function UTF8_Decode(ByVal Text As String) As String
Dim lLength&, sBuffer$
Text = StrConv(Text, vbFromUnicode)
lLength = MultiByteToWideChar(CP_UTF8, 0, StrPtr(Text), -1, 0, 0)
sBuffer = Space$(lLength)
lLength = MultiByteToWideChar(CP_UTF8, 0, StrPtr(Text), -1, StrPtr(sBuffer), Len(sBuffer))
UTF8_Decode = Left$(sBuffer, lLength - 1)
End Function
Sub Test_Ter()
Dim stg, zzz, i%, Bazinga$
stg = Array("NOM1 Marie-Ségolène", "NOM2 BÉRÉNICE", "NOM3 Marie-Ségolène", "NOM4 BÉRÉNICE", "NOM5 Marie-Ségolène", "NOM6 BÉRÉNICE", "NOM7 Marie-Ségolène")
ReDim zzz(UBound(stg))
For i = LBound(stg) To UBound(stg)
zzz(i) = UTF8_Decode(CStr(stg(i)))
Next
Bazinga = Join(zzz, Chr(10))
MsgBox Bazinga
End Sub
 

Amilo

XLDnaute Accro
re
Bonsoir Staple1600
erreur chez moi
Regarde la pièce jointe 1062494
Re,

Chez moi, le code à Staple du message #31 fonctionne et je n'ai pas de message d'erreur,
Par contre, en voyant la proposition à mapomme qui présente une autre logique,
je me demande si nous ne serions pas hors sujet car dans cet exemple, les caractères spéciaux sont remplacés par des caractères de l'alphabet !!!


Edit : oups en plus signalé par mapomme dans son message :
Cette fonction ne supprime pas les caractères spéciaux (ce qui à mon humble avis ne se justifie en aucun cas) mais les transforme en caractère ascii.

Cordialement
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re

Amilo
J'ai pu ouvrir le fichier original qui contenait des patronymes.
Les données semblaient provenir d'un import
Et le souci c'était les caractères accentués mal restranscrits
Voir exemple dans mon dernier test.
Donc mapomme était pil poil dans le cœur du sujet.
Le reste est du à ce que le confinement nous oblige à nous occuper plutôt dans VBE (que sur ma TV pour ce qui me concerne)
 

dysorthographie

XLDnaute Accro
bonsoir,
désolé mais dans ton ficher je ne vois pas de caractères spéciaux mais de l'UTF8!
VB:
Sub Test()
Debug.Print Encode_UTF8("âàèéç"), Decode_UTF8("âà èéç")
End Sub
 
 
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
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
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
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…