Поиск и вывод Даты Начала и Даты Окончания из текстаПо материалам: https://www.cyberforum.ru/ms-access/thread3103727.html Public Function GetDateFromString(vString, Optional iWhichDateReturn = 1) As Variant 'es - 07.05.2023 v001 'Функция возврашает Дату Начала и Дату Окончания из строки по аргументу '--------------------------------------------------------------------------------------------------- 'Аргумент: iWhichDateReturn - указывает какую по счёту дату вернуть ' iWhichDateReturn = 1 - функция вернёт первую дату (по умолчанию) ' iWhichDateReturn = 2 - функция вернёт вторую дату '--------------------------------------------------------------------------------------------------- Dim objRegExp As Object, oMatches Dim iVal%, sVal$, vVal Static dEndDate As Date 'Статичная Даты Окончания !!! On Error GoTo GetDateFromString_Err ' Обрабатываем строку только один раз: If iWhichDateReturn = 1 Then Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.Pattern = "\d{1,2}[\.,/-]\d{1,2}[\.,/-]\d{2,4}" Set oMatches = objRegExp.Execute(vString) vVal = Trim(oMatches(0)) GetDateFromString = DateValue(vVal) ' Заапоминаем дату окончания для повторного вызова: vVal = Trim(oMatches(1)) dEndDate = DateValue(vVal) Else 'Повторный запрос конечной даты : If dEndDate > 0 Then GetDateFromString = dEndDate 'Берём из статичной перменной End If dEndDate = 0 'зачистка ... End If GetDateFromString_End: On Error Resume Next Set objRegExp = Nothing Set oMatches = Nothing Err.Clear Exit Function GetDateFromString_Err: Err.Clear Resume GetDateFromString_End End Function
Dim sVal$ sVal = "текст в начале 10.02.2003 текст по середине 22.04.2004 ... ещё текст" Debug.Print GetDateFromString(sVal, 1) Debug.Print GetDateFromString(sVal, 2) Вернёт: 10.02.2003 22.04.2004 |
|||
L.E. 07.05.2023 |