Как удалить символы?

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

 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 - но запись замены для каждого символа делает мой код большим. Хорошо, позвольте мне ясно сказать вам, не скрывая от вас ничего:

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

123
4567
90

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

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

Спасибо заранее

Ответ 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]) или (|) пробел ().

Дополнительная информация в regexp:

Ответ 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

Ответ 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

Ответ 4

Что-то вроде этого

разделите строку с помощью regexp
поместите совпадения в массив
сбрасывает массив в диапазон размеров электронной таблицы с автоматическим размером.

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