Страницы: 1
RSS
Как извлечь из текстовой ячейки - кусок текста, что находится между двумя разделителями
 
Здравствуйте, форумчане. Подскажите по решению следующей проблемы.
Как научить макрос извлекать в ячейку D8 - тот текст в строке, который идет между словами "ЗАПИСЬ-" и ","  ?

(Причем извлеченный текст должен захватывать еще один символ по левую сторону. То есть должно получиться не "А1+Б4+А V Д",  а "-А1+Б4+А V Д".)
Изменено: Snegovik2 - 27.04.2018 18:37:38
 
Надо именно макрос? Формулой решение не подойдет?
Если автоматизировать бардак, то получится автоматизированный бардак.
 
=ПСТР(ЛЕВБ(H8;ПОИСК(",";H8)-1);ПОИСК("запись";H8)+6;99)
 
Нужен именно макрос.
Решение формулой - не подойдет.
 
Цитата
Snegovik2 написал:
текст в строке, который идет между словами "текст4-" и ","
Не нахожу такого слова - "текст4-".
 
UDF. Под конкретно Ваши условия
Код
Function ТЕКСТМЕЖДУ(cl, s1 As String, n1 As Long, s2 As String, n2 As Long) As String
'cl - текст, или ссылка на ячейку с текстом, откуда вырезаем текст
's1 - первый граничный символ
'n1 - номер вхождения первого символа
's2 - второй граничный символ
'n2 - номер вхождения второго символа
With Application.WorksheetFunction
    If s1 = s2 Then
         cl = .Substitute(.Substitute(cl, s1, Chr(5), n1), s2, Chr(6), n2 - 1)
         s1 = Chr(5)
         s2 = Chr(6)
         n1 = 1
         n2 = 1
    End If
    If n1 > 1 Then
        cl = .Substitute(cl, s1, Chr(5), n1)
        s1 = Chr(5)
        n1 = 1
    End If
    If n2 > 1 Then
        cl = .Substitute(cl, s2, Chr(6), n2)
        s2 = Chr(6)
        n2 = 1
    End If
    f1 = .Search(s1, CStr(cl), n1) + 1: f2 = .Search(s2, CStr(cl), n2)
    If f2 - f1 < 0 Then Exit Function
    ТЕКСТМЕЖДУ = Mid(CStr(cl), f1 + Len(s1) - 2, f2 - f1 - Len(s1) + 2)
End With
End Function
Согласие есть продукт при полном непротивлении сторон
 
под приведенный пример:
Код
Function FindThat$(ByVal txt$)
If InStr(txt, "-") < 1 Or InStr(txt, ",") < 1 Then FindThat = vbNullString: Exit Function
If InStr(txt, "-") >= InStr(txt, ",") Then FindThat = vbNullString: Exit Function
FindThat = Mid$(txt, InStr(txt, "-"), InStr(txt, ",") - InStr(txt, "-")-1)
End Function
Изменено: Anchoret - 27.04.2018 17:45:46
 
UDF
Код
Function iЗАПИСЬ(cell$)
 With CreateObject("VBScript.RegExp")
     .Global = True
     .IgnoreCase = True
     .Pattern = "ЗАПИСЬ(.+?)(?=,)"
     iЗАПИСЬ = .Execute(cell)(0).SubMatches(0)
 End With
End Function
 
Это все - пользовательские функции, а я спрашивал про макрос.
Имеется ввиду обычный макрос, прицепленный на кнопку, запускаемый единократно.
 
Все Вам не то )
Вы хоть бы какую каплю  благодарности выдавили, Вам же помочь стараются...
Переделайте функцию на макрос.

Сейчас выяснится, что диапазон, а не одна ячейка, и другие подробности...
 
Огромное всем спасибо за участие и низкий поклон.

Но вот все-таки нужен именно МАКРОС, а не пользовательская функция. Как выполнить эту операцию - именно макросом ?
 
Цитата
именно макросом
Код
Sub ЗАПИСЬ()
 With CreateObject("VBScript.RegExp")
     .Global = True
     .IgnoreCase = True
     .Pattern = "ЗАПИСЬ(.+?)(?=,)"
     Range("D8") = .Execute(Range("H8"))(0).SubMatches(0)
 End With
 
Kuzmich, не точно работает.

В вашем макросе - ограничитель - это слово "ЗАПИСЬ", а нужен ограничитель "ЗАПИСЬ-".
(Потому что слово "запись" - может встречаться и раньше по тексту, а вот "запись-" ставится в тексте именно как разделитель.)

Но при этом, нужно чтобы один символ слева - при переносе все-таки выхватывался - чтобы получался текст "-А1+Б4+А V Д"
 
Цитата
vikttur написал:
что диапазон, а не одна ячейка
Не одна книга, а несколько, в которых слова расположены в шахматном порядке и еще ячейки совмещены.
 
А так
Код
Sub ЗАПИСЬ()
 With CreateObject("VBScript.RegExp")
     .Global = True
     .IgnoreCase = True
     .Pattern = "ЗАПИСЬ-(.+?)(?=,)"
     If .test(Range("H8")) Then
       Range("D8") = "-" & .Execute(Range("H8"))(0).SubMatches(0)
     Else
       Range("D8") = ""
     End If
 End With
End Sub
 
Kuzmich, ну а сейчас - все просто идеально.
Огромное вам спасибо.
 
еще вариант функции в D8
 
Код
Function vvv$(t$)
   With CreateObject("VBScript.RegExp"): .Pattern = "ЗАПИСЬ-.+(?=., )"
     vvv = Mid(.Execute(t)(0), 7)
  End With
End Function
Изменено: кузя1972 - 27.04.2018 21:16:25
Страницы: 1
Наверх