从VBA中的范围中删除特殊字符开发者社区

相关文章推荐

迷茫的马克杯 · 从VBA中的范围中删除特殊字符开发者社区· 1 月前 ·

聪明伶俐的勺子 · 上海药物所提出机器学习辅助定向进化新方法· 2 年前 ·

光明磊落的铁链 · Java从json串中获取某个值 - ...· 2 年前 ·

踢足球的茶壶 · TypeScript笔记——枚举 - 掘金· 3 年前 ·

大气的手电筒 · ASP.NET Core Web API ...· 3 年前 ·

腾讯云

开发者社区

文档建议反馈控制台

首页

MCP广场

文章/答案/技术大牛

发布

Sub ReplaceSpecial()
    Dim cel As Range
    Dim strVal As String
    Dim i As Long
    Application.ScreenUpdating = False
    For Each cel In Selection
        strVal = cel.Value
        For i = 1 To Len(strVal)
            Select Case Asc(Mid(strVal, i, 1))
                Case 32, 48 To 57, 65 To 90, 97 To 122
                    ' Leave ordinary characters alone
                Case Else
                    Mid(strVal, i, 1) = " "
            End Select
        Next i
        cel.Value = strVal
    Next cel
    Application.ScreenUpdating = True
End Sub

Sub ReplaceSpecial()
    Dim cel As Range
    Dim strVal As String, temp As String
    Dim i As Long
    Application.ScreenUpdating = False
    For Each cel In Selection
        strVal = cel.Value
        temp = vbNullString
        For i = 1 To Len(strVal)
            Select Case Asc(Mid(strVal, i, 1))
                Case 32, 48 To 57, 65 To 90, 97 To 122
                    temp = temp & Mid(strVal, i, 1)                   
            End Select
        Next i
        cel.Value = temp
    Next cel
    Application.ScreenUpdating = True
End Sub

Function ValidChars(ByVal s, Optional JoinResult As Boolean = True)
'Purp: return only valid characters if space,digits,"A-Z" or "a-z"
    'compare all string characters against valid characters
    Dim tmp: tmp = foundCharAt(s)   ' get array with found positions in chars
    'overwrite tmp array
    Dim i As Long, ii As Long
    For i = 1 To UBound(tmp)
        If IsNumeric(tmp(i)) Then                   ' found in valid positions
            If Not Mid(s, i, 1) Like "[?*]" Then    ' exclude wild cards
                ii = ii + 1
                tmp(ii) = Mid(s, i, 1)  ' get char from original string
            End If
        End If
    ReDim Preserve tmp(1 To ii)         ' reduce to new size
    'join tmp elements to resulting string (if argument JoinResult = True)
    ValidChars = IIf(JoinResult, Join(tmp, ""), tmp)
End Function

Function foundCharAt(ByVal s As String) As Variant
'Purp: return array of found character positions in chars string
'Note: (non-findings show Error 2042; can be identified by IsError + Not IsNumeric)
    Dim chars: chars = String2Arr(" 0123456789abcdefghijklmnopqrstuvwxyz")
    foundCharAt = Application.Match(String2Arr(s), chars, 0)
End Function

Function String2Arr(ByVal s As String) As Variant
'Purp: return array of all single characters in a string
'Idea: https://stackoverflow.com/questions/13195583/split-string-into-array-of-characters
    s = StrConv(s, vbUnicode)
    String2Arr = Split(s, vbNullChar, Len(s) \ 2)
End Function

Sub Test()
Dim str As String: str = "abc@123!-245"
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "[^0-9A-Za-z ]"
    str = .Replace(str, "")
End With
Debug.Print str
End Sub

For i = Len(str) To 1 Step -1
    If Mid(str, i, 1) Like "[!0-9A-Za-z ]" Then
        str= Application.Replace(str, i, 1, "")

问 从VBA中的范围中删除特殊字符 EN

回答 4

Stack Overflow用户

Stack Overflow用户

Stack Overflow用户