Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Парсер в VB - записать название элемента в переменную
 
#1
26.08.2020 10:13:50
Всем добрый день! Написал парсер, но наименование чемпионата не подставляется к каждой команде, потому что в HTML заголовок, в котором написано название чемпионата один, а команд в этом чемпионате может быть несколько. Возможно ли так сделать, чтоб название чемпионата повторялось столько же раз сколько команд в этом чемпионате, помогите, пожалуйста, или посредством VBA это невозможно реализовать.
Код
Sub mar()
Dim ie As Object
Dim champ As Object
Dim champs As Object
Dim names As Object
Dim nameh As Object
Dim txt As HTMLDocument
Dim a%, b%, c%

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.Navigate "https://www.marathonbet.ru/su/betting/11?periodGroupAllEvents=24"
Set txt = ie.Document

a = Cells(Rows.Count, 2).End(xlUp).Row
Set champs = txt.getelementsbyclassname("category-label-link")
For Each champ In champs
a = a + 1
Cells(a, 1) = champ.innertext
Next champ

b = Cells(Rows.Count, 2).End(xlUp).Row
Set names = txt.getelementsbyclassname("bg coupon-row")
For Each nameh In names
    b = b + 1
    Cells(b, 2) = nameh.getAttribute("data-event-name")
Next nameh
End Sub
 
 
 
#2
27.08.2020 23:40:38
Блин, одни лентяи на форуме собрались. Никто помогать человеку не хочет ))
Человек вон уже веру в VBA потерял, а вы....
Я из-за вас уже все ближайшие футбольные чемпионаты выучил )
Где ваше хвалёное Power Query? )


Код
Sub test()
    'добавьте ссылку на "Microsoft XML 6.0" в меню Tools - References
    'добавьте ссылку на "Microsoft HTML Object Library" в меню Tools - References
 
    Dim IE As MSXML2.XMLHTTP60
    Dim HTMLDoc As MSHTML.HTMLDocument
    Dim HTMLBody As MSHTML.HTMLBody
    Dim site As String, ChampionshipName As String
    Dim LastRow As Long, i As Long
    Dim arrChamps, arrPlays, Play
    
    Set IE = New MSXML2.XMLHTTP60
    site = "https://www.marathonbet.ru/su/betting/11?periodGroupAllEvents=24"
    IE.Open "GET", site, False
    IE.send
     
    'ждём загрузку сайта
    While IE.readyState <> 4: DoEvents: Wend
     
    Set HTMLDoc = New MSHTML.HTMLDocument
    Set HTMLBody = HTMLDoc.body
    HTMLBody.innerHTML = IE.responseText
    
    arrChamps = Split(HTMLBody.innerHTML, "category-label")

    Cells.Clear
    For Each Play In arrChamps
        'название чемпионата
        If InStr(1, Play, "data-ellipsis=""{}""><SPAN class=nowrap>", vbTextCompare) > 0 Then
            ChampionshipName = Replace(Play, " "" data-ellipsis=""{}""><SPAN class=nowrap>", "")
            ChampionshipName = Replace(Mid(ChampionshipName, 1, InStr(1, ChampionshipName, "</SPAN></H2>", vbTextCompare) - 1), "</SPAN> <SPAN class=nowrap>", "")
        End If
        
        'название игры
        arrPlays = Split(Play, "data-event-name")
        If UBound(arrPlays) > 0 Then
            For i = 1 To UBound(arrPlays)
                LastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
                Cells(LastRow, 1) = ChampionshipName 'столбец 1 - чемпиона
                Cells(LastRow, 2) = Split(arrPlays(i), "data-event-treeId")(0) 'столбец 2 - игра
            Next i
        End If
    Next Play
    
    [A1] = "Чемпионат":    [B1] = "Игра"
    [A1].CurrentRegion.Borders.LineStyle = xlContinuous
    Columns("A:B").AutoFit
End Sub
Изменено: New - 31.08.2020 15:49:53
 
 
 
#3
28.08.2020 00:34:21
Цитата
Anton Anton написал:
Возможно ли так сделать, чтоб название чемпионата повторялось столько же раз сколько команд в этом чемпионате
Код
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    ie.Navigate "https://www.marathonbet.ru/su/betting/11?periodGroupAllEvents=24"
    
    While ie.ReadyState <> 4
        DoEvents
    Wend
    
    Set HTMLDocument = ie.Document
    
    For Each cat In HTMLDocument.GetElementsByClassName("category-container")
        For Each champ In cat.GetElementsByClassName("category-label-link")
            For Each nameh In cat.GetElementsByClassName("bg coupon-row")
                Cells(Cells(Rows.Count, 2).End(xlUp).Row + 1, 1) = champ.innertext
                Cells(Cells(Rows.Count, 2).End(xlUp).Row + 1, 2) = nameh.getAttribute("data-event-name")
            Next nameh
        Next champ
    Next cat
    
    Set HTMLDocument = Nothing
    Set ie = Nothing

Можете использовать такие ссылки, если нужно пройтись по всем страницам.
 
 
 
#4
28.08.2020 06:37:16
Сайт с подзагрузкой, поэтому вариант с CreateObject("InternetExplorer.Application") лучше
Изменено: Роберт Иванов - 28.08.2020 06:41:08
 
 
 
#5
28.08.2020 06:42:40
Oleg Boyaroff, New, Блииииин вы даже себе не представляете как я РАД, все получилось, СПАСИБО РЕБЯТА ВСЕМ ОТ ДУШИ, сейчас буду разбирать код!!!!!!!!!!!!!!!!!
 
 
 
#6
28.08.2020 10:14:50
Цитата
New написал:
Где ваше хвалёное Power Query? )
Ребята не обижайте Power Query))))
С другого сайта забираю инфу но смысл я так понял один что необходимо было))).
 
 
 
#7
28.08.2020 10:23:05
Не, я не обижаю. PQ очень мощный и очень важный инструмент. Просто я вчера попробовал загрузить через него именно тот сайт, который был нужен ТС и у меня 2 раза полностью зависал Excel. Что приходилось снимать задачу в диспетчере. Видно сайт загружен и PQ не справляется. Попробуйте сами взять ссылку ТС и загрузить через pq
Про PQ я шутил, т.к. никто через него не предложил решение за вчерашний день.
Я конечно ещё ждал, что придет человек, который распарсит сайт именно по классам html как сделал Олег в его коде и мне не пришлось бы писать костыли через split
Изменено: New - 28.08.2020 10:30:13
 
 
 
#8
28.08.2020 10:33:20
Ага там какая то или блокировка стоит с Марафона или ещё что то.
Поэтому забрал данные со старого надёжного сайта. Я так же пошутил про PQ.
 
 
 
Страницы: 1
Наверх