Как мне удалить персонажей?

Question

Как удалить специальные символы и алфавиты в строке?

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

Мне нужно преобразовать его в

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

, но в нем должны быть пробелы!

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

Я нашел vba Replace - но написание замены для каждого символа делает мой код большим.Хорошо, позвольте мне сказать вам ясно, не скрывая ничего от вас:

1. input: qwe123 4567*. 90 'Строка с пробелами (1, "A"). Value
2. MyИдея сделать это следующим образом: 123 4567 90 'удалить символы, сначала сохраняя пробелы
3. окончательный вывод в A1:A3

   123
   4567
   90

(для каждого пробела следует вставить строку и заполнить ее)

Не могли бы вы рассказать, как удалить все символы, кроме цифр и пробелов в строке?

Заранее спасибо

Answer 1

Вам нужно использовать регулярное выражение.

См. Этот пример:

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

Пояснение:
Pattern = "([0-9]| )+" будет соответствовать любой 0 или более группе (+), содержащей число ([0-9]) или (|) пробел ().

Дополнительная информация в регулярном выражении:

• нить на озгрид
• очень хорошая ссылка о регулярном выражении

Answer 2

Без повторной альтернативы;

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

Для:

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

Answer 3

Эти два забавных кода исполнят ваши желания ...

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

Answer 4

Примерно так:

• разбить строку, используя регулярное выражение
• , поместив совпадения в массив
• , дамп массива вдиапазон автоматически настраиваемых таблиц

основной подпункт

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 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