Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Как из тэга HTML вытащить только текст с помощью VBA
 
#1
11.03.2018 04:52:23
Доброго времени суток!  Задача такая: в один из столбцов excel выгружается со страницы формы текст, но он вместе с тэгами HTML, названиями полей.
Как убрать весь технический набор символов и оставить только текст - в частности это русские буквы? Спасибо!
Изменено: Baria - 11.03.2018 04:53:24
 
 
 
#2
11.03.2018 05:15:27
Цитата
Baria написал:
и оставить только текст - в частности это русские буквы?
а арабские цифры Вас не интересуют?
а разделительные и другие знаки?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#3
11.03.2018 05:26:51
Здесь есть нужный вам код:
http://excelvba.ru/code/html
Код
Function ConvertHTMLtoText(ByVal txt$, Optional RemoveExtraLF As Boolean = False) As String
    ' Функция преобразует HTML в текст без использования DOM
    ' Создание функции было обусловлено утечками памяти при использовании библиотеки MSHTML
    ' ...
End Function
 
 
 
#4
11.03.2018 06:46:22
Игорь, спасибо, изучаю...

Ігор Гончаренко, да арабские и разделители тоже будут встречаться. Интересуют тоже.
 
 
 
#5
18.03.2018 15:13:25
Цитата
Игорь написал:
Здесь есть нужный вам код:  http://excelvba.ru/code/html
Добрый день! Скажите, а как правильно использовать эту функцию ConvertHTMLtoText ?

У меня в excel есть колонка AB в которой все записи с html тэгами. Как правильно применить функцию, чтобы в колонке AC остался только текст без тэгов ?
Много кода писал на VBA, но c функциями мало сталкивался. Спасибо!
 
 
 
#6
18.03.2018 19:18:42
1) скопировать код функции в стандартный модуль в вашем файле
2) написать в ячейке AC2 формулу  =ConvertHTMLtoText (AB2)
3) протянуть формулу вниз
 
 
 
#7
18.03.2018 20:21:43
Игорь, спасибо большое!!!
 
 
 
#8
18.03.2018 23:12:04
Спасибо, работает!!
 
 
 
#9
22.03.2018 10:25:59
Добрый день! Функция убирает почти все тэги. Остаются символы: <b>, </b>, <div style-color^red>, <strong> , <strong> , </div> - изучал код, экспериментировал, но не получилось избавится от этих. Подскажите, пожалуйста, куда нужно прописать код и какой, чтобы избавится от вышеприведенных символов? Заранее благодарю за помощь!
 
 
 
#10
22.03.2018 11:24:55
Доброе время суток.
Цитата
Baria написал:
Функция убирает почти все тэги
Попробуйте элементарную функцию на регулярных выражениях. Без примера, что есть, что должно быть - это как на пальцах разговаривать.
Код
Public Function onlyText(ByVal textVal As String) As String
    Dim pReg As Object
    Set pReg = CreateObject("VBScript.RegExp")
    pReg.Global = True: pReg.Pattern = "<.+?>"
    onlyText = Application.Trim(pReg.Replace(textVal, " "))
End Function
Изменено: Андрей VG - 22.03.2018 11:25:23
 
 
 
#11
22.03.2018 11:45:57
Цитата
Андрей VG написал:
Без примера, что есть, что должно быть - это как на пальцах разговаривать.
Игорь, вот что получается:
Скрытый текст

Цель: Чтобы остался только текст. Спасибо Вам за помощь!
 
 
 
#12
22.03.2018 12:07:00
Цитата
Baria написал:
Игорь, вот что получается
Это вы ко мне? Дык, я не Игорь. А где как нужно? Раз вы даёте половинчатые ответы, получайте частичное решение. ;)
Код
Public Function onlyText(ByVal textVal As String) As String
    Dim pReg As Object
    Set pReg = CreateObject("VBScript.RegExp")
    pReg.Global = True: pReg.Pattern = "<.+?>"
    textVal = Replace$(Replace$(textVal, "&lt;", "<"), "&gt;", ">")
    onlyText = Application.Trim(pReg.Replace(textVal, " "))
End Function

P. S. Функция Игоря, кстати, дала абсолютно правильный результат, с точки зрения форматирования HTML документа и текстового содержимого в нём.
Изменено: Андрей VG - 22.03.2018 12:12:47
 
 
 
#13
22.03.2018 13:08:48
Приношу свои извинения, Андрей! Нужно только текст:
"В рамках одного обращения Вы можете задать только один вопрос или сообщить об одной ошибке.Не следует возвращать запрос в работу для дополнительного вопроса. Нужно оформить новое обращение и указать в нём номер исходного.Текст2 Дата, озвучиваемая КлиентуТекст3 Текст3 Текст4 Текст5 Текст6. Текст7 Текст8 Текст9 Текст10. Текст10 ОсновнойТекстВажный Приложить шаблон в соответствии с типом доработки"
 
 
 
#14
22.03.2018 13:53:44
Как убрать оставшиеся символы?
 
 
 
#15
22.03.2018 13:55:51
Применить в коде функцию Replace, с указанием что на что поменять. Пример есть в коде. Давайте уж и вы будете участником, а не только Ctrl+C, Ctrl+V
 
 
 
#16
22.03.2018 13:56:41
в вашем случае, мою функцию надо применить 2 раза подряд:
=ConvertHTMLtoText(ConvertHTMLtoText (AB2))
 
 
 
#17
22.03.2018 14:19:55
Спасибо!!! Получилось!
 
 
 
#18
23.03.2018 14:13:55
Добрый день! Подскажите, пожалуйста, все же лишнее убрано! т.е. код убрал и тот текст, который описывает Label. т.е. наименование поля. Можно ли Эти названия не удалять ?
например часть тэга такая: id="a2" label="Проблема(описание)".
Нужно оставить: "Проблема (описание).

Спасибо!
Изменено: Baria - 23.03.2018 19:17:38
 
 
 
#19
23.03.2018 17:33:39
Baria, можно. Вот немного доработал функцию АндреяVG, в качестве второго параметра указываете атрибут тега, который надо сохранить:
Код
Public Function onlyTextWithAttributeValue(ByVal textVal As String, ByVal attributeToSave As String) As String
    Dim pReg As Object
    Set pReg = CreateObject("VBScript.RegExp")
    pReg.Global = True: pReg.Pattern = "<.+" & attributeToSave & "\=" & Chr(34) & "([^" & Chr(34) & "]*).*>"
    textVal = Replace$(Replace$(textVal, "&lt;", "<"), "&gt;", ">")
    onlyText = Application.Trim(pReg.Replace(textVal, "$1"))
End Function

Правда, учтите, что функция будет чистить только теги, в которых есть заданный атрибут и ему присвоено значение (атрибуты типа readonly без знака равно и значения в кавычках не будут учитываться).

В теории, можно вообще довести регулярное выражение до идеала, но лично мне проще использовать несколько регулярных выражений или даже функций, чем ломать мозг над каждым возможным символом, собирая комплексную задачу в одно регулярное выражение.

В итоге у Вас должно получиться что-то вроде формулы: =onlyText(onlyTextWithAttribute(A1; "label"))

Изменено: Irregular Expression - 23.03.2018 17:34:44
 
 
 
Страницы: 1
Наверх