Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Парсинг части кода из html страницы
 
#1
06.04.2017 14:51:46
Всем привет!
Прошу помощи. Необходимо выдернуть из html страницы некоторые значения и записать из в определенные ячейки.
В данном примере выдернуть надо значение этажа (21) и площадь окса (38,9)
Фрагмент html кода:
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
                     <tr>
                            <td align="left" valign="top" width="250">
                                <nobr>Этаж:</nobr>
                            </td>
                            <td width="75%" valign="top">
                                    <b>21</b>
                            </td>
                        </tr>
 
                    <tr>
                        <td align="left" valign="top" width="250" nowrap="true">
                            <nobr>
                                Площадь ОКС'a:
                            </nobr>
                        </td>
                        <td width="75%" valign="top">
                                <b>38,9</b>
                        </td>
                    </tr>
 
                    <tr>
                        <td align="left" valign="top" width="250" nowrap="true">
                            Единица измерения (код):
                        </td>
                        <td width="75%" valign="top">
                            <b>Квадратный метр</b>
                        </td>
                    </tr>

код:
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Test1()
    Dim sEnv As String, sURL As String
    Dim xmlhtp As Object
    sURL = "https://rosreestr.ru/wps/portal/p/cc_ib_portal_services/online_request/!ut/p/z1/pVFNc4IwEP01Xs1GtKK3...jc8fmMbUlN0GT-vHyezVllBEZg-KiwhbK0W-3kH6km9d7YKTu2d-9gXOgOyt/p0/IZ7_01HA1A42K0EE90ABVVBS3S2001=CZ6_GQ4E1C41KGQ170AIAK131G00T5=MEcontroller!QCPObjectDataController==/?object_data_id=" & Cells(ActiveCell.Row, 55) & "&dbName=firLite®ion_key=177"
    Set xmlhtp = CreateObject("MSXML2.XMLHTTP")
    With xmlhtp
        .Open "POST", sURL, "False"
            '  .setRequestHeader "Content-Length", b
            '   .setRequestHeader "Content-Type", "application/json; charset=utf-8"
            '   .setRequestHeader "Accept", "application/json"
              '  .setRequestHeader "Authorization", "Token 2688a4ce9e30e66310292f3bf96a2b9881711279"
                .setRequestHeader "Host", "http://rosreestr.ru/api/online/address/fir_objects"
        .send ' (sEnv)
       Worksheets(1).Cells(ActiveCell.Row, 56) = .responseText
    End With

Спасибо!
Изменено: solar25 - 06.04.2017 14:56:28
 
 
 
#2
06.04.2017 15:23:19
Формульное решение при условии, что html записан в H30.
Для этажа:
Код
?
1
=ЗНАЧЕН(ПСТР(ПСТР(H30;ПОИСК("этаж:";H30);200);ПОИСК("<b>";ПСТР(H30;ПОИСК("этаж:";H30);200))+3;ПОИСК("</b>";ПСТР(H30;ПОИСК("этаж:";H30);200))-ПОИСК("<b>";ПСТР(H30;ПОИСК("этаж:";H30);200))-3))
Для площади:
Код
?
1
=ЗНАЧЕН(ПСТР(ПСТР(H30;ПОИСК("Площадь ОКС'a:";H30);200);ПОИСК("<b>";ПСТР(H30;ПОИСК("Площадь ОКС'a:";H30);200))+3;ПОИСК("</b>";ПСТР(H30;ПОИСК("Площадь ОКС'a:";H30);200))-ПОИСК("<b>";ПСТР(H30;ПОИСК("Площадь ОКС'a:";H30);200))-3))
Следствие из третьего закона Чизхолма:
"Даже если ясность изложения исключает неверное толкование, все равно найдется кто-то, кто поймет Вас неправильно."
 
 
 
#3
06.04.2017 15:40:03
PerfectVam, благодарю, так я пробовал, там количество символов динамически изменяется между тегами...но структура - всегда одна.

на php так разбирали, как в vba реализовать - непонятно:
Код
?
1
2
3
4
5
6
if(preg_match_all('|<td align="left" valign="top" width="\d*[\s\S]*>(.+)</td>\s*<td[\s\S]*width="75%"[\s\S]*>(.+)</td>|isU', $mhtml, $maindata)){
            // нашли и разбираем данные
            foreach($maindata[1] as $td => $cat){
                $cat = strip_tags(trim($cat));
                $maindata[2][$td] = strip_tags(trim($maindata[2][$td]));
if(strpos($cat, 'Площадь') !== false) $ploshad_GKN = trim($maindata[2][$td]);
Изменено: solar25 - 06.04.2017 15:41:18
 
 
 
#4
06.04.2017 15:49:38
Здесь есть функция для преобразования HTML в текст
http://excelvba.ru/code/html

а дальше - 1 или 2 сложенных функции SPLIT
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#5
06.04.2017 16:48:00
Специально вроде сделал с запасом - 200 символов.
Ориентировался именно на структуру. Суть формулы: поиск ключа (Этаж, площадь), взятие 200 символов правее, поиск в оставшемся первых <b> и </b> и перевод в число того, что между ними. Единственная тонкость, которая еще может быть - это десятичный разделитель (в разных настройках по-разному. У меня - запятая)
Ладно. Чтобы не привязываться к 200 символов, можно оставлять все правее. Так точно не потеряем. А на структуру, как я объяснил и было рассчитано!
Условность прежняя.
Для этажа:
Код
?
1
=ЗНАЧЕН(ПСТР(ПРАВСИМВ(H30;ДЛСТР(H30)-ПОИСК("этаж:";H30));ПОИСК("<b>";ПРАВСИМВ(H30;ДЛСТР(H30)-ПОИСК("этаж:";H30)))+3;ПОИСК("</b>";ПРАВСИМВ(H30;ДЛСТР(H30)-ПОИСК("этаж:";H30)))-ПОИСК("<b>";ПРАВСИМВ(H30;ДЛСТР(H30)-ПОИСК("этаж:";H30)))-3))
Для площади:
Код
?
1
=ЗНАЧЕН(ПСТР(ПРАВСИМВ(H30;ДЛСТР(H30)-ПОИСК("Площадь ОКС'a:";H30));ПОИСК("<b>";ПРАВСИМВ(H30;ДЛСТР(H30)-ПОИСК("Площадь ОКС'a:";H30)))+3;ПОИСК("</b>";ПРАВСИМВ(H30;ДЛСТР(H30)-ПОИСК("Площадь ОКС'a:";H30)))-ПОИСК("<b>";ПРАВСИМВ(H30;ДЛСТР(H30)-ПОИСК("Площадь ОКС'a:";H30)))-3))
Или у Вас именно по условию код VBA нужен? Тогда дело другое...
Следствие из третьего закона Чизхолма:
"Даже если ясность изложения исключает неверное толкование, все равно найдется кто-то, кто поймет Вас неправильно."
 
 
 
#6
06.04.2017 17:44:30
solar25, так вы же там json запрашиваете, а возвращает HTML?
F1 творит чудеса
 
 
 
#7
06.04.2017 18:15:46
Максим Зеленский, json закомментирован, от старого кода остался.
 
 
 
#8
06.04.2017 18:22:03
Игорь,супер-функция, спасибо! все получилось.
Только смущает момент. сейчас я выдергиваю так:
Код
?
1
2
3
4
5
6
7
8
9
res = Split(GetTags(rep, "tr", "", "", "outerHTML"), ARSEP)
'MsgBox (res)
'Worksheets(1).Cells(ActiveCell.Row, 56) = res(10)
MsgBox (res(11))
 
zn = GetTags(res(10), "b", "", "", "innerHTML")
Worksheets(1).Cells(ActiveCell.Row, 56) = zn
zn = GetTags(res(11), "b", "", "", "innerHTML")
Worksheets(1).Cells(ActiveCell.Row, 57) = zn


а если они еще одну таблицу добавят, нужные данные в массиве сместятся на позицию...
можно же искать конкретный фрагмент, например по ключу "Этаж" и разбирать именно его, а не всю страницу?
 
 
 
#9
06.04.2017 18:25:21
PerfectVam,дело в том, что формулой здесь получается нестабильно...площадь может быть значением дробным, получим усечение....между тегами <tr> может быть больше пробелов и т.д...хочется более изящное решение. Со скриптом работать удобнее. Тем не менее спасибо за отклик!
 
 
 
#10
07.04.2017 01:16:30
Попробуйте так.
Скрытый текст
 
 
 
#11
07.04.2017 08:38:00
Здравствуйте,
А зачем парсить html? Открываете карту Росреестра, нажимаете ручками на нужный ОКС при открытом инспекторе. На вкладке сеть ждем прогрузки json файла. Берем оттуда хедеры и параметры запроса. После получения ответа от сервера в xmlhttp запросе загоняем этот самый ответ с помощью внешней библиотеки в словарь/коллекцию словарей/коллекций (не помню, какая там структура сейчас). Библиотеку по конвертации в json можно найти на гитхабе.
Я сам сделал подобную штуку, только для ЗУ. Если интересно могу дать код.
С уважением,
Федор/Все_просто
 
 
 
Страницы: 1
Читают тему
Наверх
Loading...