Страницы: 1
RSS
Удалить все что между знаками < и >
 
Я подобную тему уже создавал на этом форуме, но изначально неправильно задачу поставил.
А задача такова: имеем много строк с текстом - надо этот текст очистить от мусора, который находится между символами "<" и ">", в принципе весь текст будет только на русском, а соответственно можно оставить только кириллицу и знаки препинания, а все остальное удалить.

И важный момент - надо это в виде формулы (т.е. по нажатию кнопки не подходит) и НЕ СТИРАТЬ два тега: <br> и <br/>

Прилагаю 2 файла:
1) один пример текста который мне надо очистить
2) а во втором файле в принципе все работает как мне надо, только там по кнопке, а мне надо в виде формулы.
 
Цитата
virus555 пишет: НЕ СТИРАТЬ два тега: <br> и <br/>
чет не видно где они в примерах распологаются
Лень двигатель прогресса, доказано!!!
 
Добавил
 
вобщем поэксперементировал в столбец С ставите такую формулу
Код
 =ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПСТР(D5;1;НАЙТИ("</p>";D5)+3);"<br/>";"(br/)");"<br>";"(br)")
протягиваете копируете значения в книгу с макросом удаляете <*>, потом обрабатываете в обратную сторону (br) заменяете на <br>
Лень двигатель прогресса, доказано!!!
 
Сергей, та с <br> это второстепенная задача.
Главная - это формулой удалять <*>
 
в прошлой теме сами сказали что этих вариантов <*> сто и более и будут добавляться, в формуле не предусмотришь удалить то, что пока я не знаю, но оно вероятно скорее всего будет, но я в этом сейчас не уверен,
тут тока если УДФ
Лень двигатель прогресса, доказано!!!
 
Сергей, ну так я и не против УДФ, просто вы мне в прошлой теме сделали макросом, а меня интересует можно ли тот макрос переделать в УДФ, чтобы его можно было вызывать на листе в виде ф-ции.  
 
ждите добрых людей из клана рунописцев
Лень двигатель прогресса, доказано!!!
 
Я переделал макрос под ф-ию вот так:

Код
Function МояФункция(Arg1 As Range)
        Arg1.Replace What:="<*>", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Function

Но она почему-то выводит результат в ячейку выбранную для Arg1, а не в ту ячейку, в которой записана сама функция.
Изменено: virus555 - 17.05.2014 14:48:34
 
Походу сегодня все рунописцы отдыхают  :cry:
 
Код
Function МояФункция(Arg1 As Range)
        
МояФункция=Arg1.Replace What:="<*>", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Function

 
 
Kuzmich, так не работает
 
В общем нашел такой код, который выполняет мою задачу:


Код
Function StripTags(ByVal html As String) As String
    Dim text As String
    Dim accumulating As Boolean
    Dim n As Integer
    Dim c As String

    text = ""
    accumulating = True

    n = 1
    Do While n <= Len(html)

        c = Mid(html, n, 1)
        If c = "<" Then
            accumulating = False
        ElseIf c = ">" Then
            accumulating = True
        Else
            If accumulating Then
                text = text & c
            End If
        End If

        n = n + 1
    Loop

    StripTags = text
End Function
 
 
Готовое решение для вашего файла
(по преобразованию диапазона ячеек из HTML в текст)
http://excelvba.ru/code/Convert_HTML_Range_To_Text
 
Вариант с UDF и регулярными выражениями по мотивам замены <b> от Игоря

Код
Private FReg As Object
Public Function GetInnerText(ByVal this As String) As String
    If FReg Is Nothing Then
        Set FReg = CreateObject("VBScript.RegExp")
        FReg.Global = True
    End If
    FReg.Pattern = "<(?:b|B) ?/?>"
    this = FReg.Replace(this, "«b»")
    FReg.Pattern = "<.+?>"
    GetInnerText = FReg.Replace(this, "")
End Function
 
Успехов.
 
Код
Function f$(s$)
  With CreateObject("vbscript.regexp")
    .ignorecase = True: .Pattern = "<(?!/?br).*?>": .Global = True
    f = .Replace(s, "")
  End With
End Function
пс. решение для "нормальных" тегов <br> и </br>
если же оч. хочется всё-таки для <br/>, то меняем шаблон на "<(?!br/?).*?>"
Изменено: ikki - 18.05.2014 07:59:00
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Добрый день Александр
Спасибо за науку. Как-то пропустил, что можно и исключение настроить.
 
добрый день, Андрей.
просто интересно было запихнуть всё в одну регулярку.
а с практической точки зрения я совсем не уверен, что это будет оптимальный по скорости вариант.   ;)  
имхо, если нужна скорость - здесь вообще лучше обойтись без регулярок.
правда, код подлиннее будет.
Изменено: ikki - 18.05.2014 08:05:06
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Код
<p>Если 2 < 5, то обе ваши функции на базе Regexp никуда не годятся... </p> 
:)
 
Игорь, мою версию можно подправить:;

Код
 Private FReg As Object
Public Function GetInnerText(ByVal this As String) As String
    If FReg Is Nothing Then
        Set FReg = CreateObject("VBScript.RegExp")
        FReg.Global = True: FReg.IgnoreCase = True
    End If
    FReg.Pattern = "<br ?/?>"
    this = FReg.Replace(this, "«br»")
    FReg.Pattern = "<[^<>]+?>"
    GetInnerText = FReg.Replace(this, "")
End Function
Александра, так

Код
Function f$(s$)
  With CreateObject("vbscript.regexp")
    .IgnoreCase = True: .Pattern = "\<(?!br ?/?)[^<>]+?>": .Global = True
    f = .Replace(s, "")
  End With
End Function
 
Изменено: anvg - 18.05.2014 09:22:55
 
Код
<p>Если в текст встретятся 2 < 5 и 5 > 7, уже не говоря о вложенных символах < и >, которые допустимы в HTML, -  
то шаблон Regexp окажется настолько сложным, что проще использовать мой вариант </p>  
PS: я вовсе не говорю о том, что ваш вариант не подходит для топикстартера.
Для его задачи - любой из предложенных функций более чем достаточно, вероятность ошибки крайне низка.

Моя функция, кстати, тоже далеко не идеальна, - при некоторых значениях ячеек, может выдать некорректный вариант,
или даже Excel может вылететь (в системной библиотеке Windows есть ошибки, которые при некотором HTML приводят к сбою.
Такое редко, но бывает, - например, если в HTML используются скрипты в событиях объектов)
Изменено: Игорь - 18.05.2014 09:29:27
 
Игорь, да я не спорю. Просто подправил под один из вариантов. А по стандарту html не рекомендуется, как минимум, использовать <> в качестве символов текста, нужно заменять на < и &rt; чтобы не приводило к сбоям. В вашем же тексте (а вариант вполне возможен)
встретятся 2<p и n > 7
будет так же обрублено <p и 5 >
Хотя, на мой взгляд, ваша версия предпочтительнее тем, что по идее должна выдать реальный символ вместо: < &rt;  
З. Ы. Игорь, не упрёк, но может всё же объявлять переменные явно? Зачем учить начинающих не очень хорошему стилю?
Изменено: anvg - 18.05.2014 10:14:39
 
Код
Function f$(s$)
  With CreateObject("vbscript.regexp")
    .ignorecase = True: .Pattern = "<(?!/?br)[^<]*?>": .Global = True
    f = .Replace(s, "")
  End With
End Function
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Всем спасибо буду разбираться в предложенных вариантах
 
virus555 не забудьте на другом форуме отписаться о результатах.  :)
Изменено: V - 18.05.2014 11:40:35
 
Цитата
Игорь пишет:
HTML
Вы наверное будете смеяться, но на соседнем кибере попутно выяснилось, что это таки не хтмл.
это таки wiki, и тег нужен именно <br/>

со всем остальным по поводу возможной встречи символов угловых скобок где угодно можно согласиться.
но тогда нужно брать полную спецификацию - и работать с ней.
не один день.
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Цитата
тег нужен именно <br/>
нормальные браузеры понимают все 3 варианта написания этого тега:
Код
<br>,  <br/>, <br />
А чудо-браузер Internet Explorer - только последний вариант
 
Цитата
anvg пишет: Private FReg As Object
Static внутри функции
Цитата
anvg пишет: ...может всё же объявлять переменные явно? Зачем учить начинающих не очень хорошему стилю?
а еще On Error Resume Next
и еще Convert_HTML_Range_To_Text подразумевает, что html будет преобразован в текст. Непонятно почему <br /> остаются в неизменном виде
и еще =) Convert_HTML_Range_To_Text лично я бы понимал как "собрать все данные в "кучу" и преобразовать в текст", а не для каждой ячейки раскладывать
и еще =) в vba функции пишутся так ConvertHTMLRangeToText (согласно наименованию встроенных функций) (code style)
и еще =) ...

лично я бы написал простую изолированную функцию вида HTMLToText() без ячеек, кот. можно было бы использовать в разных приложениях, а не только в excel
впрочем, "лично я" в данный момент ничего бы не стал писать   :D
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук


https://github.com/nervgh
Страницы: 1
Наверх