Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

19 Октябрь 2018, 16:33 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Здесь можно поблагодарить участников форума Улыбка
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: 1   Вниз
  Печать  
Автор Тема: [РЕШЕНО] Поиск даты в текстовой переменной  (Прочитано 1472 раз)
0 Пользователей и 1 Гость смотрят эту тему.
ost
Форумчанин
***
Offline Offline

Сообщений: 83


« Стартовое сообщение: 6 Апрель 2018, 08:32 »

Доброго.
Помогите решить задачу средствами StarBasic. Прошу прощения, если вопрос уже был разжеван ранее. Времени оч. мало. Беглый поиск результата не дал.
Задача: Получить в переменную sTarget дату из текстовой переменной sSource. sSource может содержать любой текст, но дата всегда в формате "DD.MM.YYYY". В sTarget нужно получить первое вхождение из sSource.

Спасибо.
« Последнее редактирование: 6 Апрель 2018, 18:21 от ost » Записан
mikekaganski
Мастер
*****
Offline Offline

Пол: Мужской
Расположение: Хабаровск -> Москва
Сообщений: 1 063


« Ответ #1: 6 Апрель 2018, 09:21 »

Код:
Sub Main
  Dim s As String
  s = "asdfasdfasdas12.14.1987sdflsdlfjl12.14.1987"
  Dim r As Object
  r = RegexSearch(s, "\d\d\.\d\d\.\d{4}")
  Dim s1 As String
  If (r.subRegExpressions=1) Then
    s1 = mid(s, r.startOffset(0)+1, r.endOffset(0)-r.startOffset(0))
  EndIf
  Print s1
End Sub

REM Adapted from https://forum.openoffice.org/en/forum/viewtopic.php?f=44&t=89845#p424049
REM nStart is zero-based
REM returns com.sun.star.util.SearchResult
Function RegexSearch (str As String, regex As String, Optional nStart) As Object
  If (IsMissing(nStart)) Then nStart = 0
  Dim opts As New com.sun.star.util.SearchOptions
  opts.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
  opts.searchString = regex
 
  Dim ts As Object
  ts = CreateUnoService("com.sun.star.util.TextSearch")
  ts.setOptions(opts)
  RegexSearch = ts.searchForward(str, nStart, Len(str))
End Function
Записан

С уважением,
Михаил Каганский
JohnSUN
Капитана в тот день называли на "ты"
Гуру
*******
Offline Offline

Пол: Мужской
Расположение: Киев
Сообщений: 2 593


Помогаю людям и компьютерам понимать друг друга


WWW
« Ответ #2: 6 Апрель 2018, 10:49 »

mikekaganski стреляет быстрее...  Всё хорошо
Зато у меня тестовый пример длиннее и 14-ый месяц не прокатит  Смеющийся
Код:
Option Explicit
Option Base 0

Sub Main
Dim a As String, r As Variant
a = "Отчет составлен 05.04.2018 года"
r = searchDDMMYYYY(a)
MsgBox("В строке" & Chr(10) & "'" & a & "'" & Chr(10) & "найдены даты:" & Chr(10) & Join(r,Chr(10)), 64, "Результат")

a = "за период с 01.01.2016 по 31.12.2017 года"
r = searchDDMMYYYY(a)
MsgBox("В строке" & Chr(10) & "'" & a & "'" & Chr(10) & "найдены даты:" & Chr(10) & Join(r,Chr(10)), 64, "Результат")

a = "Проанализирован договор №13 от 12.11.2015 года (дата начала 01.01.2016, окончание 31.02.2018)," & Chr(10) & _
"по которому поступили платежи 13.01.2016 (123.16), 32.06.2016 (28.10) и 3 12.12.2017 года (112.45)"
r = searchDDMMYYYY(a)
MsgBox("В строке" & Chr(10) & "'" & a & "'" & Chr(10) & "найдены даты:" & Chr(10) & Join(r,Chr(10)), 64, "Результат")

a = "12.10.201615.10.201617.10.2016 есть сведения о платежах, но не указаны суммы"
r = searchDDMMYYYY(a)
MsgBox("В строке" & Chr(10) & "'" & a & "'" & Chr(10) & "найдены даты:" & Chr(10) & Join(r,Chr(10)), 64, "Результат")

End Sub

Function searchDDMMYYYY(sourceString As String) As Variant
Dim Res As Variant
Dim uTextSearch As Object, oResult As Object, r As Long, i As Long, srchPos As Long, s As String
Dim aOptions As New com.sun.star.util.SearchOptions
aOptions.searchString = "(0[1-9]|[12][0-9]|3[01])\.(0[1-9]|1[012])\.(19|20)\d\d"
aOptions.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
aOptions.searchFlag = com.sun.star.util.SearchFlags.REG_EXTENDED

uTextSearch = createUnoService("com.sun.star.util.TextSearch")
uTextSearch.setOptions(aOptions)
Res = Array()

srchPos = 0
oResult = uTextSearch.searchForward(sourceString, srchPos, Len(sourceString))
Do While oResult.subRegExpressions > 0
s = Mid(sourceString, oResult.startOffset(0) + 1, oResult.endOffset(0) - oResult.startOffset(0))
addToArray(s, Res)
srchPos = oResult.endOffset(0)
oResult = uTextSearch.searchForward(sourceString, srchPos, Len(sourceString))
Loop
searchDDMMYYYY = Res
End Function

Sub addToArray(key, arr)
Dim uB As Long
uB = UBound(arr)+1
ReDim Preserve arr(uB)
arr(uB) = key
End Sub
Записан

Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне
ost
Форумчанин
***
Offline Offline

Сообщений: 83


« Ответ #3: 6 Апрель 2018, 18:20 »

Ребята, спасибо за оперативность. Благодаря вам куча глупой работы пошла лесом. Огромное спасибо.
JohnSUN, отдельное спасибо за обстоятельный код.
Записан
Страниц: 1   Вверх
  Печать  
 
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2009, Simple Machines Valid XHTML 1.0! Valid CSS!