Fatal编程技术网
  • excel/
  • 使用宏从Excel电子表格中删除任何非指定字符

使用宏从Excel电子表格中删除任何非指定字符

excel vba

使用宏从Excel电子表格中删除任何非指定字符,excel,character,vba,Excel,Character,Vba,我正试图清除Excel中的.CSV文件中的任何非标准字符。我唯一关心的字符是A-Z、0-9和一些标准标点符号。任何其他字符，我想删除 我让下面的宏在找到包含我没有指定的字符的单元格时删除整行，但我不确定如何让它实际删除字符本身 Sub Replace() Dim sCharOK As String, s As String Dim r As Range, rc As Range Dim j As Long sCharOK = "abcdefghijklmnopqrstuvwxyzABCDEFG

我正试图清除Excel中的.CSV文件中的任何非标准字符。我唯一关心的字符是A-Z、0-9和一些标准标点符号。任何其他字符，我想删除

我让下面的宏在找到包含我没有指定的字符的单元格时删除整行，但我不确定如何让它实际删除字符本身

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

子替换（）
Dim sCharOK作为字符串，s作为字符串
变暗r为范围，rc为范围
Dim j尽可能长
sCharOK=“abcdefghijklmnopqrstuvxyzabcdefghijklmnopqrstuvxyz012456789，` ~！@$%^&*（）_+-=[]\{}|'：”，./？™®"
设置r=工作表（“功能”）.UsedRange.SpecialCells（xlCellTypeConstants，XLTextValue）
'循环使用文本常量值遍历所有单元格，并删除字符不在sCharOK中的行
对于r中的每个rc
s=rc.值
对于j=1至Len（s）
如果InStr（sCharOK，Mid（s，j，1））=0，则
rc.EntireRow.Delete
退出
如果结束
下一个j
下一个rc
端接头
我假设有一种相当简单的方法可以使代码适应该函数，但我对VBA还不太熟悉，不知道如何去做。非常感谢您的任何见解！

如果是我，我会在每次发现无效字符时对原始字符串使用替换命令，将该无效字符更改为null。然后，repl用修改后的字符串替换原始单元格值。类似这样的

一种可能的方法（已测试）

Sub-RemoveInvalidCharacters（）
Dim sCharOK作为字符串，s作为字符串
变暗r为范围，rc为范围
Dim j尽可能长
Dim badchar为布尔型
sCharOK=“abcdefghijklmnopqrstuvxyzabcdefghijklmnopqrstuvxyz012456789，`~！@$%^&*()_+-=[]\{}|;':"",./?™®"
设置r=工作表（“功能”）.UsedRange.SpecialCells（xlCellTypeConstants，XLTextValue）
'使用文本常量值和
'从每个值属性中删除非sCharOK中的无效字符
对于r中的每个rc
badchar=False
s=rc.值
对于j=1至Len（s）
如果InStr（sCharOK，Mid（s，j，1））=0，则
badchar=True
s=替换（s，Mid（s，j，1），“”）
如果结束
下一个j
如果是badchar那么
rc.值=s
如果结束
下一个rc
端接头
另一种方法是
范围。替换类似于：


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


或直接在即时窗口中运行此一行：


ActiveSheet.UsedRange.Value = Evaluate("TRIM(CLEAN(" & ActiveSheet.UsedRange.Address & "))")



您还可以使用正则表达式，从而避免需要检查循环中的每个字符（尽管正则表达式引擎必须这样做）

下面解释的正则表达式模式包含字符列表，使用的字符类表示匹配未列出的所有字符

如果速度成为一个问题，您可以使用vba数组来加快速度


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


正则表达式模式的解释
[^\x20-\x7E\x99\xAE]

    

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

      

    • \x20-\x7E
      

        

      • \x20
        • 

      • \x7E
        • 

      • 

    • \x99
      • 

    • \xAE
      • 

    • 



用
创建的，我今天就要这么做了。下面的脚本非常适合我


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



Sub-Clean_和_-Trim_单元（）
Application.ScreenUpdating=False
Application.Calculation=xlCalculationManual
像线一样变暗
对于ActiveSheet.UsedRange中的每个c
s=c.值
如果修剪（应用清洁），则
s=阀内件（应用清洁）
c、 值=s
如果结束
下一个
Application.ScreenUpdating=True
Application.Calculation=xlCalculationAutomatic
端接头

sCharOK
是所有正常的字符。
Mid（s，j，1）
是要检查的字符串中的实际字符。
InStr（sCharOK，Mid（s，j，1））=0
=>位置
j
处的字符无效。
replace（s，j，”）
然后将替换字符串
s
中的数值
j
…我确定您要运行
s=replace（s，Mid（s，j，1），“”）
；）谢谢德克，我在格式化问题上太纠结了，我的大脑在错误的道路上向左拐了一个急转弯。逻辑很好，语法不好：）流畅。代码少了很多，并且利用了应该快得多的内置代码。如果Unicode字符的代码大于
FF
，那怎么办？@RonRosenfeld他们不能出现是因为“我正在尝试清理一个.CSV文件…”和““我是对你的答案投赞成票的人之一，因为它简单而快速。仅指出一个可能的限制，该限制甚至可能不适用于此特定情况。但是，csv文件可能包含这些讨厌的字符，如果设置正确，可以将它们导入Excel。@RonRosenfeld如果我的评论听起来粗鲁或类似的话，我很抱歉。我是个很好的人，英语说（写）得不太好。我还对你的答案投了更高的票，因为它完全符合OP的要求。但在最后，为每个单元格运行可能会更慢。然而，这主要取决于细胞的数量。@DirkReichel绝对正确。如果有很多单元格，我会使用VBA数组。但是使用正则表达式模式也会删除所有未列出的字符，包括Unicode字符。无意中删除了我的注释：如果OP真的需要它（或者只是觉得无聊），他可以使用
ChrW
从-32768到65535运行我的代码：P@DirkReichel我们甚至不知道这是否必要。但我确实喜欢你发布的简单解决方案。

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



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



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