[Resolu] Supprimer caracteres speciaux

For i = 1 To Range("A65536").End(xlUp).Row
  For Z = 1 To Range("B65536").End(xlUp).Row
    Range("A" & i) = Replace(Range("A" & i), Range("B" & Z), "")
  Next Z
Next i

Function AlphaPur(target As String) As String
Dim x As String, z As String, i As Integer
z = ""
For i = 1 To Len(target)
x = Mid(target, i, 1)
If x < "A" Or x > "z" Or (x > "Z" And x < "a") Then
z = z & " "
Else
z = z & x
End If
Next
AlphaPur = Application.Trim(z)
End Function

For i = 1 To Range("A65536").End(xlUp).Row
  For Z = 1 To Range("B65536").End(xlUp).Row
    Range("A" & i) = Replace(Range("A" & i), Range("B" & Z), " ")
  Next Z
Next i

Sub Epure()
Dim tablo, E, t, i&
tablo = [Liste] 'caractères spéciaux
E = Range("A1:A2", Range("A" & Rows.Count).End(xlUp))
For Each t In tablo
  For i = 1 To UBound(E)
    E(i, 1) = Application.Trim(Replace(E(i, 1), t, " "))
  Next
Next
E(1, 1) = "Epuré" 'si ligne de titres
[B1].Resize(UBound(E)) = E
End Sub

Function EPURE$(ByVal txt$, Csp As Range)
Dim t
   For Each t In Csp: txt = Replace(txt, t, " "): Next
   EPURE = Application.Trim(txt)
End Function

Function EPURE$(ByVal txt$, Csp As Range)
Dim tablo, t
   tablo = Csp.Value
   If Not IsArray(tablo) Then ReDim tablo(1): tablo(1) = Csp.Value
   For Each t In tablo: txt = Replace(txt, t, " "): Next
   EPURE = Application.Trim(txt)
End Function

Option Explicit
Sub test()
    Dim chain As String

    chain = "blablabla@_toto_')titi4586_=#@ hfdh...cbzjdcn:fer;fgt'g/fefefe"

    MsgBox ReplaceSpecChar(chain) 'replace tout les caractères speciaux

    MsgBox ReplaceSpecChar(chain, RegularSpace:=True) 'replace tout les caractères speciaux et régule les espaces consécutifs

    MsgBox ReplaceSpecChar(chain, "_") 'replace tout les caractères speciaux par un caractère

    MsgBox ReplaceSpecChar(chain, ExceptedChar:=".@_") 'replace tout les caractères speciaux en  exeptant certains

End Sub
Function ReplaceSpecChar(chain As String, _
                         Optional CharReplace As String = " ", _
                         Optional ExceptedChar As String = "", _
                         Optional RegularSpace As Boolean = False)
    Dim T As String, I&
    For I = 1 To Len(chain)
        Select Case Asc(Mid(chain, I, 1))
        Case 48 To 57, 65 To 90, 97 To 122, Asc(Chr(160))
            T = T & Mid(chain, I, 1)
        Case Else
            If ExceptedChar Like "*" & Mid(chain, I, 1) & "*" Then
                T = T & Mid(chain, I, 1)
            Else
                T = T & CharReplace
            End If
        End Select
    Next
    If RegularSpace Then T = Application.Trim(T)
    ReplaceSpecChar = T
End Function