Страницы: 1
RSS
Извлечь текст между двумя последовательностями символов, Есть формула, нужна короткая пользовательская функция
 
Всем привет.
Есть список файлов с путями. В имени файла присутствует называние фирмы.
Нужно в отдельном столбце вывести называние фирмы. На данный момент я делаю это формулой, ищу последовательность символов справа и слева и извлекаю текст между ними. Формула непрозрачная, не всем понятная и можно легко сломать. В файле примере я для наглядности вынесла границы в отдельные ячейки, но обычно эти границы стоят прямо в формуле.
Т.к. расположение файлов меняется, то и границы, нужно указывать каждый раз разные.

Хотелось бы более элегантное решение в виде пользователькой функции, с 3мя аргументами (текст; "левая_граница"; "правая_граница")

Буду признательна


 
 
Доброе время суток.
Цитата
ЕжеВика написал:
в виде пользователькой функции
Вариант.
Код
Public Function getTextBetween(ByVal text As String, ByVal textBefore As String, ByVal textAfter As String) As String
    Dim pReg As Object
    Set pReg = CreateObject("VBScript.RegExp")
    pReg.Pattern = safePattern(textBefore) & "(.+?)(?=" & safePattern(textAfter) & ")"
    getTextBetween = pReg.Execute(text)(0).SubMatches(0)
End Function

Private Function safePattern(ByVal thisText As String) As String
    Dim temp As String
    temp = Replace$(thisText, "\", "\\")
    safePattern = temp
End Function

P. S. safePattern - допиливаете по мере необходимости. В прочем, полагаю, коллеги предложат вариант без регулярных изысков. :)
 
Код
Function funk(ccel As Range, startTxt As String, endTxt As String)
    With ccel.Cells(1)
        txt = Right(.Value, Len(.Value) - InStr(1, .Value, startTxt) - Len(startTxt) + 1)
        txt = Left(txt, InStr(1, txt, endTxt))
    End With
    funk = txt
End Function
In GoTo we trust
 
еще вариант функции
Код
 Function funk$(t$, t1$, t2)
With CreateObject("VBScript.RegExp"): .Pattern = t1 & "\" & ".+(?= " & t2 & ")": funk = Trim(Mid(.Execute(t)(0), Len(t1)+1))
End With
End Function
Изменено: кузя1972 - 20.08.2018 16:47:25
 
Спасибо за отклики!
Андрей VG- работает, но не знаю почему :D , буду изучать, попытаюсь разобрать
tolstak- работает, похоже, как по моей формуле!
кузя1972, выдает почему-то  #ЗНАЧ
 
добрый вечер, в файл примере функция занесена в диапазон B4:B6, в C2 занес uli\ ,а  в D2 19,все для данного файл-примера работает,приложите файл-пример,где не работает,регулярных выражений на все случаи жизни не бывает.
 
Ок, может криво вставила. Сейчас работает, но не очень универсально.
Например текст будет V:\Book\Work\Power2018\07 Juli\Sent Juli\Anciled OOO 191601 07.18 UPS.doc
Самая глубокая и ей предыдущая папка имеют одинаковое окончание. Т.е. левая граница "uli\" не подойдет. В своей старой формуле я просто беру последовательность длиннее, например "t Juli\" или "Sent Juli\", все равно.  Думаю, правую границу тоже можно двигать.
Навреное у вас другой подход, я в регулярных пока ни бум-бум, так что проверить не могу. :)
В принципе, решение уже есть, дальнейшие исправления будут лишь познавательны, но не обязательны, ценю Ваше время :)  
Изменено: ЕжеВика - 21.08.2018 12:54:54 (удалена цитата)
 
в ответ на #7,Вы фактически расширили файл-пример(строка 7),для такого расширенного файл-примера рекомендую UDF funk1 в диапазоне C4:C7
 
Код
Function funk1$(t$, t1$, t2)
With CreateObject("VBScript.RegExp"): .Pattern = t1 & "\" & "[^\\]+?(?= " & t2 & ")": funk1 = Trim(Mid(.Execute(t)(0), Len(t1) + 1))
End With
End Function
Изменено: кузя1972 - 21.08.2018 16:35:39
 
кузя1972, ваш #4 вариант бы работал. Достаточно там было подавить жадность.
 
Привет!

Цитата
ЕжеВика написал:
элегантное решение
Код
Public Function extract_beTween(ByVal txt As String, _
                                ByVal sLeft As String, _
                                ByVal sRight As String) _
                                As String
    If Len(txt) * Len(sLeft) * Len(sRight) Then
        Dim s()  As String
        s = Split(txt, sLeft)
        s = Split(s(1), sRight)
        extract_beTween = s(0)
    End If
End Function
Изменено: Inexsu - 21.08.2018 15:11:17
Сравнение прайсов, таблиц - без настроек
 
Андрей VG,добрый вечер,чисто устранение жадности в func (добавление знака вопроса к .+) здесь не помогает,можно использовать еще другой паттерн в func
 
Код
.Pattern = t1 & "\" & "[ а-яёa-z]+(?= " & t2 & ")" 
и
Код
 .IgnoreCase=True
Изменено: кузя1972 - 20.08.2018 23:49:33
 
Цитата
кузя1972 написал:
(добавление знака вопроса к .+) здесь не помогает,
Да, вы правы, коллега. Спасибо за замечание. Лучше как у вас
Цитата
кузя1972 написал:
[^\\]+
 
Inexsu,  элегантно, но не работает, например на строке 7 в вайле-примере из сообщ #9
Добравлю в копилку простых кодов для изучния, зная что он делает, спасибо.

кузя1972, funk1 отлично, спасибо! жаль, что не скоро пойму как это работает  :)
 
Цитата
ЕжеВика написал:
Inexsu,  элегантно, но не работает
Похоже и c этим решением у вас
Цитата
ЕжеВика написал:
не скоро пойму как это работает
Код
s = Split(s(Ubound(s)), sRight)
Изменено: Андрей VG - 21.08.2018 14:05:10
 
Inexsu, Я извиняюсь, проверяла с некорректными аргументами. Элегантное решение работает!
 
Для изучения примеры с регулярными выражениями замечательны. Для практики (как и написал Андрей в #2) тексты подстрок необходимо экранировать, иначе при поиске подстрок типа "\d" возникнут проблемы (проверьте). Для комплекта стандартное решение (см. также #3):
Код
' Ищет подстроку в text между первым вхождением textBefore и первым вхождением textAfter.
' Если ignoreCase<>0, то сравнение строк производится без учета регистра символов
' При ненахождении возвращает пустую строку
Public Function getTextBetween(ByVal text As String, ByVal textBefore As String, _
       ByVal textAfter As String, Optional ByVal ignoreCase = 0) As String
  Dim i1 As Long, i2 As Long, compare
  compare = IIf(ignoreCase = 0, vbBinaryCompare, vbTextCompare)
  i1 = InStr(1, text, textBefore, compare)
  If i1 = 0 Then Exit Function
  i1 = i1 + Len(textBefore)
  i2 = InStr(i1, text, textAfter, compare)
  If i2 > 0 Then getTextBetween = Mid(text, i1, i2 - i1)
End Function
Изменено: sokol92 - 21.08.2018 14:45:50
Владимир
Страницы: 1
Наверх