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

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

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

В таблице MS Access есть текстовое поле (столбец) строки которого внутри текста содержат даты или даже несколько дат в одной строке в текстовом же формате, например:
"... фкур птапч... 12.04.2019 или 12.04.19 ... увр ап прона...".
Вопрос. Каким наиболее простым способом (или функцией) найти и вытащить из текста дату, чтобы потом поместить её в отдельное поле (столбец) этой же или другой таблицы?

- Попробуйте функцию с регэкспом

Public Function OnlyDate(stroka)
    Dim objRegExp As Object, oMatches
    Dim i, s, k
    
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True
    
    objRegExp.Pattern = "\d{1,2}[\.,/-]\d{1,2}[\.,/-]\d{2,4}"
    Set oMatches = objRegExp.Execute(stroka)
    For i = 0 To oMatches.Count - 1
        k = Trim(oMatches(i))
        If Left(k, 1) = "(" Then k = k & ")"
        s = s & "," & k
    Next
    
    OnlyDate = Mid(s, 2)
End Function

Пробуем в Immediate

?OnlyDate("... фкур птапч... 12.04.2019 или 12.04.19 ... увр ап прона...")
12.04.2019,12.04.19
 
?OnlyDate("... фкур птапч... 12.04.2019 . увр ап прона...")
12.04.2019

\d{1,2} - цифры до 2 знаков
[\.,/-] - любые символы из перечисленных
\d{2,4} - цифра 2-4 символа


?OnlyDate("... фкур птапч... 12-04,24 ап прона...")
12-04,24


имхо - и , лучше убрать


Public Function CountDates(vStroka) As Integer
'Подсчёт дат в строке
'----------------------------------------------------------------
Dim objRegExp As Object, oMatches  As Object
On Error GoTo CountDates_Err
    
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True
    
    objRegExp.Pattern = "\d{1,2}[./-]\d{1,2}[./-]\d{2,4}"
    
    Set oMatches = objRegExp.Execute(vStroka)
    CountDates = oMatches.Count

CountDates_End:
    On Error Resume Next
    Set objRegExp = Nothing
    Set oMatches = Nothing
    Err.Clear
    Exit Function

CountDates_Err:
    CountDates = -1
    Err.Clear
    Resume CountDates_End
End Function

Назад ToTop
L.E. 23.12.2022
Рейтинг@Mail.ru