Suppression de tout caractère non spécifié d'une feuille de calcul Excel à L'aide d'une Macro

j'essaie de nettoyer un .Fichier CSV dans Excel en se débarrassant de tous les caractères non standard. Les seuls caractères que je garde sont a-Z, 0-9, et quelques signes de ponctuation standard. Tous les autres personnages, j'aimerais supprimer.

j'ai obtenu la macro suivante pour supprimer une rangée entière quand elle trouve une cellule qui contient des caractères que je n'ai pas spécifiés, mais je ne suis pas sûr de la façon de l'obtenir pour réellement supprimer le caractère lui-même. 

Sub Replace()
Dim sCharOK As String, s As String
Dim r As Range, rc As Range
Dim j As Long

sCharOK = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789, `~!@#$%^&*()_+-=[]{}|;':"",./<>?™®"

Set r = Worksheets("features").UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)

' loop through all the cells with text constant values and deletes the rows with characters not in sCharOK
For Each rc In r
    s = rc.Value
    For j = 1 To Len(s)
        If InStr(sCharOK, Mid(s, j, 1)) = 0 Then
            rc.EntireRow.Delete
            Exit For
        End If
    Next j
Next rc

End Sub

je suppose qu'il y a une façon assez simple d'adapter ce code à cette fonction, mais je ne suis pas assez familier avec VBA pour savoir vraiment comment faire cela. Toute perspicacité est grandement appréciée!

2
demandé sur Community 2017-08-10 02:44:00

4 réponses

une autre façon serait Range.Replace comme: 

Sub test()
  Dim sCharOK As String
  sCharOK = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789, `~!@#$%^&*()_+-=[]\{}|;':"",./<>?™®" & Chr(1)
  Dim i As Long
  For i = 0 To 255
    If InStr(sCharOK, Chr(i)) = 0 Then
      ActiveSheet.Cells.Replace What:=Chr(i), Replacement:="", LookAt:=xlPart, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    End If
  Next
End Sub

MODIFIER

regarder @ryguy72 la réponse offre aussi une autre façon si seulement les caractères non imprimables doivent être supprimés (à la question quelque chose comme µ²äöüßÉõ sera supprimé mais ce code ne sera pas) en supposant également qu'il ya pas de formules : 

Sub test()
  With ActiveSheet.UsedRange
    .Value = Evaluate("TRIM(CLEAN(" & .Address & "))")
  End With
End Sub

ou directement exécuter dans la fenêtre immédiate une doublure: 

ActiveSheet.UsedRange.Value = Evaluate("TRIM(CLEAN(" & ActiveSheet.UsedRange.Address & "))")
3
répondu Dirk Reichel 2017-08-10 03:05:20

vous pouvez également utiliser des expressions régulières, évitant ainsi d'avoir à examiner chaque caractère dans une boucle. (Bien que le moteur d'expressions régulières a à faire).

le motif Regex, expliqué ci-dessous, contient votre liste de caractères, et la classe de caractères utilisée dit correspondent à tout ce qui n'est pas listé.

si la vitesse devient un problème, vous pouvez utiliser des tableaux vba pour accélérer les choses. 

Option Explicit
Sub ReplaceNonStdChars()
    Const sPat As String = "[^\x20-\x7E\x99\xAE]"
    Dim RE As Object
    Dim R As Range, C As Range

Set R = Worksheets("features").UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)

Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .Pattern = sPat
    For Each C In R
        C.Value = .Replace(C.Text, "")
    Next C
End With
End Sub

explication du motif Regex

[^\x20-\x7E\x99\xAE] 

[^\x20-\x7E\x99\xAE]

créé avec RegexBuddy

2
répondu Ron Rosenfeld 2017-08-10 01:11:48

si c'était moi, j'utiliserais une commande replace sur la chaîne originale chaque fois que je trouve un char invalide, changeant ce char invalide En null. Ensuite, remplacez la valeur originale de la cellule par la chaîne modifiée. Quelque chose comme cela...

Une façon possible (testé) 

Sub RemoveInvalidCharacters()
Dim sCharOK As String, s As String
Dim r As Range, rc As Range
Dim j As Long
Dim badchar As Boolean

sCharOK = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789, `~!@#$%^&*()_+-=[]\{}|;':"",./<>?™®"

Set r = Worksheets("features").UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)

' loop through all the cells with text constant values and
' deletes the invalid characters not in sCharOK from each Value property
For Each rc In r
    badchar = False
    s = rc.Value
    For j = 1 To Len(s)
        If InStr(sCharOK, Mid(s, j, 1)) = 0 Then
            badchar = True
            s = Replace(s, Mid(s, j, 1), "")
        End If
    Next j
    If badchar Then
        rc.Value = s
    End If
Next rc

End Sub
2
répondu R Hughes 2017-08-10 01:31:57

il fallait que je fasse ça aujourd'hui, littéralement. Le scénario ci-dessous a parfaitement fonctionné pour moi. 

Sub Clean_and_Trim_Cells()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim s As String
    For Each c In ActiveSheet.UsedRange
        s = c.Value
        If Trim(Application.Clean(s)) <> s Then
            s = Trim(Application.Clean(s))
            c.Value = s
        End If
    Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
1
répondu ryguy72 2017-08-10 02:34:44