Excel VBA цикл через строку чисел, пока не будет найдена буква

У меня есть строка в ячейке, скажем, она говорит "Client Ref: F123456PassPlus". Возможно, строка не имеет буквы перед числами, возможно, в числах есть символ, и возможно, что между буквой и числами есть пробел. Мне нужно извлечь только числа как переменную. У меня есть код для этого, но он не знает, когда прекратить цикл через строку. Он должен остановиться, когда есть что-то другое, чем число или символ, но он продолжает вместо.

IsNumber = 1
ref = ""
If branch = "" Then
    e = b
Else
    e = b + 1
End If
f = 1
While IsNumber = 1
    For intpos = 1 To 15
        ref = Mid(x, e, f)
        f = f + 1
        Select Case Asc(ref)
            Case 45 To 57
                IsNumber = 1
            Case Else
                IsNumber = 0
                Exit For
        End Select
    Next
    IsNumber = 0
Wend

любые переменные буквы, которые не имеют определений, были определены ранее, e сообщает коду, где начать копирование, а x-это ячейка, содержащая строку. На данный момент все работает нормально, он начинается с числа и копирует их и строит их в большую и большую строку, но он остановится только тогда, когда intpos достигнет 15.

3 ответов


Я избавился от проверки Asc и добавил проверку против каждого символа, когда вы передаете его перед построением числовой "строки".

IsNumber = 1
ref = ""
If branch = "" Then
    e = b
Else
    e = b + 1
End If
f = 1
While IsNumber = 1
    For intpos = 1 To 15
        char = Mid(x, e + intpos, 1)
        f = f + 1
        If IsNumeric(char) Then
            ref = Mid(x, e, f)
            IsNumber = 1
        Else
            IsNumber = 0
            Exit For
        End If
    Next
    IsNumber = 0
Wend

нет ничего плохого в том, как вы пытаетесь выполнить эту задачу, но я не могу удержаться от предложения regex :-)

в этом примере из строки, расположенной в A1 и представить результат в окне сообщения. Используемый шаблон [^0-9]

Sub StripDigits()
    Dim strPattern As String: strPattern = "[^0-9]"
    Dim strReplace As String: strReplace = vbnullstring
    Dim regEx As New RegExp
    Dim strInput As String
    Dim Myrange As Range

    Set Myrange = ActiveSheet.Range("A1")

    If strPattern <> "" Then
        strInput = Myrange.Value
        strReplace = ""

        With regEx
            .Global = True
            .MultiLine = True
            .IgnoreCase = False
            .Pattern = strPattern
        End With

        If regEx.test(strInput) Then
            MsgBox (regEx.Replace(strInput, strReplace))
        Else
            MsgBox ("Not matched")
        End If
    End If
End Sub

убедитесь, что вы добавили ссылку на "Microsoft VBScript регулярные выражения 5.5"

для получения дополнительной информации о том, как использовать регулярное выражение в Excel, включая примеры цикла через диапазоны проверить этот пост.

результаты:

enter image description here


этот код, свободно основанный на вашем, работает (производит "12345"). Для больших строк или более сложных потребностей извлечения я бы рассмотрел изучение COM-объекта regex.

Function ExtractNumber(ByVal text As String) As String

  ExtractNumber = ""

  foundnumber = False

  For e = 1 To Len(text)
    ref = Mid(text, e, 1)
        Select Case Asc(ref)
            Case 45 To 57   'this includes - . and /, if you want only digits, should be 48 to 57
                foundnumber = True
                ExtractNumber = ExtractNumber & ref
            Case Else
                If foundnumber = True Then Exit For
        End Select
  Next

End Function