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

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

10 Июль 2020, 06:53 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Доступно и просто о работе в офисных пакетах
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: 1   Вниз
  Печать  
Автор Тема: Какая функция возвращает дважды встречающееся в ячейке слово?  (Прочитано 1629 раз)
0 Пользователей и 1 Гость смотрят эту тему.
mikekaganski
Гуру
*******
Offline Offline

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


« Ответ #48963: 28 Ноябрь 2018, 22:54 »

Код:
Function OnlyDuplicates(s As String) As String
  GlobalScope.BasicLibraries.LoadLibrary("Tools")
  Dim ts As Object, so As New com.sun.star.util.SearchOptions
  ts = createUnoService("com.sun.star.util.TextSearch")
  so.searchString = "(?-i)\b(\w+)\b.*\b\1\b"
  so.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
  so.searchFlag = com.sun.star.util.SearchFlags.REG_EXTENDED ' deprecated
  ts.setOptions(so)
  Dim pos As Long, sr As Object, result() As String, this As String, i As Long
  While (pos<Len(s))
    sr = ts.searchForward(s, pos, Len(s))
    If (sr.subRegExpressions = 2) Then
      this = Mid(s, sr.startOffset(1)+1, sr.endOffset(1)-sr.startOffset(1))
      If (Not FieldInList(this, result)) Then
        i = UBound(result)+1
        ReDim Preserve result(LBound(result) To i)
        result(i) = this
      End If
      pos = sr.endOffset(1) ' no "+1": can a word boundary be without a non-word char in between?
    Else
      pos = Len(s) ' end
    End If
  Wend
  OnlyDuplicates = Join(result)
End Function
« Последнее редактирование: 29 Ноябрь 2018, 10:17 от mikekaganski » Записан

С уважением,
Михаил Каганский
Страниц: 1   Вверх
  Печать  
 
Перейти в:  

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