21

我需要从字符串中删除所有非字母数字字符，除了 Excel 中的句点和空格。使用 VBA 而不是纯 excel 函数的解决方案就可以了。

4

4 回答 4

43

将此函数插入​​到 Visual Basic 编辑器中的新模块中：

Function AlphaNumericOnly(strSource As String) As String
    Dim i As Integer
    Dim strResult As String

    For i = 1 To Len(strSource)
        Select Case Asc(Mid(strSource, i, 1))
            Case 48 To 57, 65 To 90, 97 To 122: 'include 32 if you want to include space
                strResult = strResult & Mid(strSource, i, 1)
        End Select
    Next
    AlphaNumericOnly = strResult
End Function

现在您可以将其用作用户定义函数，即如果您的数据在单元格中A1，则将此公式放在一个空单元格中=AlphaNumericOnly(A1)。

如果您想直接转换大范围，即在不离开源代码的情况下替换所有非字母数字字符，您可以使用另一个 VBA 例程执行此操作：

Sub CleanAll()
    Dim rng As Range

    For Each rng In Sheets("Sheet1").Range("A1:K1500").Cells 'adjust sheetname and range accordingly
        rng.Value = AlphaNumericOnly(rng.Value)
    Next
End Sub

只需将此子程序放在同一模块中并执行它。但请注意，这将替换该范围内的任何公式。

于 2013-03-30T21:39:09.617 回答
9

这是使用模式匹配从字符串中删除“您想要的任何字符”的另一种方法。

  • 下面的示例删除了除字母、数字、空格和句点 ( [A-Z.a-z 0-9]) 之外的所有内容

  • 为了提高效率，它还利用了 VBA在字符串和字节数组之间的无缝转换：

cleanString功能：

Function cleanString(str As String) As String
    Dim ch, bytes() As Byte: bytes = str
    For Each ch In bytes
        If Chr(ch) Like "[A-Z.a-z 0-9]" Then cleanString = cleanString & Chr(ch)
    Next ch
End Function

更多信息：

于 2018-11-06T13:24:25.970 回答
9

I was looking for a more elegant solution than the one I came up with. I was going to use ashleedawg's code above as it certainly is neater than my code. Ironically, mine ran 30% quicker. If speed is important (say you have a few million to do), try this:

    Public Function AlphaNumeric(str As String) As String
    Dim i As Integer

    For i = 1 To Len(str)
        If InStr(1, "01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz. ", Mid(str, i, 1)) Then AlphaNumeric = AlphaNumeric & Mid(str, i, 1)
    Next
End Function

There's a surprise around every corner with VBA. I'd never imagine this would be quicker...

于 2019-04-23T12:36:14.933 回答
2

我编写了以下代码，就我测试它而言，它可以工作，它由两个函数组成。第一个检查字符串是否为字母数字，第二个进行替换（它也删除空格）

Public Function Isalphanumeric(cadena As String) As Boolean

    Select Case Asc(UCase(cadena))
        Case 65 To 90 'letras
            Isalphanumeric = True
        Case 48 To 57 'numeros
            Isalphanumeric = True
        Case Else
            Isalphanumeric = False

    End Select

End Function

这里是删除功能

Function RemoveSymbols_Enhanced(InputString As String) As String

 Dim InputString As String
 Dim CharactersArray()
 Dim i, arrayindex, longitud As Integer
 Dim item As Variant


 i = 1
 arrayindex = 0
 longitud = Len(InputString)

'We create an array with non alphanumeric characters
 For i = 1 To longitud

  If Isalphanumeric(Mid(InputString, i, 1)) = False Then
    ReDim Preserve CharactersArray(arrayindex)
    CharactersArray(arrayindex) = Mid(InputString, i, 1)
    arrayindex = arrayindex + 1

  End If

  Next

 'For each non alphanumeric character we do a replace
 For Each item In CharactersArray
  item = CStr(item)
  InputString = Replace(InputString, item, "")
 Next


End Function
于 2018-02-07T10:01:14.230 回答