How do I remove the characters?

问题:

How do I remove special characters and alphabets in a string ?

 qwert1234*90)!  ' this might be my cell value

I have to convert it to

 123490  ' I mean I have to remove everything but keep only the numbers in string

but it should allow spaces !

 qwe123 4567*. 90  ' String with spaces
 123 4567 90     ' output should be

I found the vba Replace - but writing a replace for each character makes my code big. Well let me tell you clearly without hiding anything from you:

1. input: qwe123 4567*. 90 ' String with spaces cells(1,"A").value
2. My idea to do these next: 123 4567 90 ' remove characters first keeping white spaces
3. final output in A1:A3

   123
   4567
   90

(for every space it should insert row and fill that)

Could you tell me how do remove all characters except numbers and spaces in string?

Thanks In advance

回答1:

You need to use a regular expression.

See this example:

Option Explicit

Sub Test()
    Const strTest As String = "qwerty123 456 uiops"
    MsgBox RE6(strTest)
End Sub

Function RE6(strData As String) As String
    Dim RE As Object, REMatches As Object

    Set RE = CreateObject("vbscript.regexp")
    With RE
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = "([0-9]| )+"   
    End With

    Set REMatches = RE.Execute(strData)
    RE6 = REMatches(0)

End Function

Explanation:
Pattern = "([0-9]| )+" will match any 0 or more group (+) containing a number ([0-9]) or (|) a space ().

Some more info on the regexp:

• a thread on ozgrid
• a very good reference about regexp

回答2:

Non-re alternative;

Public Function fmt(sValue As String) As String
    Dim i As Long
    For i = 1 To Len(sValue) '//loop each char
        Select Case Mid$(sValue, i, 1) '//examine current char
            Case "0" To "9", " " '//permitted chars
               '//ok
            Case Else
               Mid$(sValue, i, 1) = "!" '//overwrite char in-place with "!"
        End Select
    Next
    fmt = Replace$(sValue, "!", "") '//strip invalids & return
End Function

For:

?fmt("qwe123 4567*. 90") 
123 4567 90

回答3:

Those two funny codes will do both of your whishes..

Sub MySplitter(strInput As String)
    Row = 10  ' Start row
    Col = "A" ' Column Letter
    Range(Col & Row) = ""   ' Clean the start cell
    For i = 1 To Len(strInput)  ' Do with each Character in input string...
        c = Mid(strInput, i, 1) ' Get actual char
        If IsNumeric(c) Then Range(Col & Row) = Range(Col & Row) & c ' If numeric then append to actual cell
        If (c = " ") And (Range(Col & Row) <> "") Then 'If space and actual row is not empty then...
            Row = Row + 1           ' Jump to next row
            Range(Col & Row) = ""   ' Clean the new cell
        End If
    Next
End Sub

Function KeepNumbersAndSpaces(ByVal strInput As String)
    For i = 1 To Len(strInput)  ' Do with each Character in input string...
        c = Mid(strInput, i, 1) ' Get actual char
        If IsNumeric(c) Or c = " " Then ' If numeric or a space then append to output
            KeepNumbersAndSpaces = KeepNumbersAndSpaces & c
        End If
    Next
End Function

Sub Test()
    strInput = "qwert1234*90)! qwe123 4567*. 90"
    MySplitter (strInput)
    Range("A5") = KeepNumbersAndSpaces(strInput)
End Sub

回答4:

Something like this to

• split the string using a regexp
• place the matches into an array
• dump the array to an automatically sized spreadsheet range

main sub

Sub CleanStr()
Dim strOut As String
Dim Arr
strOut = Trim(KillChar("qwe123 4567*. 90 "))
Arr = Split(strOut, Chr(32))
[a1].Resize(UBound(Arr) + 1, 1) = Application.Transpose(Arr)
End Sub

function

Function KillChar(strIn As String) As String
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .Global = True
        .Pattern = "[^\d\s]+"
        KillChar = .Replace(strIn, vbNullString)
    End With
End Function