VBA, MS Access MS Access в примерах

Поиск и вывод Числа внутри текста

По материалам: https://www.cyberforum.ru/ms-access/thread3063160.html

Public Function GetNumberFromString(vString) As Long
'Возврат числа (первого попавшегося) из строки
'---------------------------------------------------------------------------------------------------
Dim vVal, iVal%
Const sSeparator$ = " " 'Разделитель частей ; тут = пробел
Dim vArr As Variant
On Error GoTo GetNumberFromString_Err
    
    vArr = Split(vString & "", sSeparator)
    For iVal = 0 To UBound(vArr)
        vVal = Val(vArr(iVal))
        If vVal > 0 Then
            GetNumberFromString = vVal
            Exit For
        End If
    Next iVal

GetNumberFromString_End:
    Exit Function

GetNumberFromString_Err:
    Err.Clear
    Resume GetNumberFromString_End
End Function



Вариант с использованием "Регулярных выражений"
Читаем например:
   VBA Excel. Регулярные выражения (объекты, свойства, методы)
   https://vremya-ne-zhdet.ru/vba-excel/regulyarnyye-vyrazheniya/
   +
   Синтаксис регулярного выражения
   https://learn.microsoft.com/ru-ru/previous-versions/ae5bf541(v=vs.100)

Public Function Func_GetNumbers(sVal As String) As Variant
'Возврат числа из строки (RegExp)
'---------------------------------------------------------------------------------------------------
Dim objRegExp As Object, objMatch As Object
    Set objRegExp = CreateObject("VBScript.RegExp")

'Свойство Global - Определяет продолжительность поиска
    'objRegExp.Global = True  'True — по всему тексту
    objRegExp.Global = False  'False — до первого совпадения
    
'Строка, используемая как шаблон (только для целых чисел):
    objRegExp.Pattern = "\d+" 'Или так: "[0-9]+"

    For Each objMatch In objRegExp.Execute(sVal)
        Func_GetNumbers = objMatch.Value
        'Debug.Print objMatch.Value
    Next
    
    Set objMatch = Nothing
    Set objRegExp = Nothing
End Function



То же самое без цикла:

With CreateObject("VBScript.RegExp")
    .Pattern = "\d+"
    With .Execute(S)
        If .Count > 0 Then Debug.Print .Item(0).Value
    End With
End With
Назад ToTop
L.E. 14.12.2023
Рейтинг@Mail.ru