Парсер Delux_plus

[x]

Наверно большинство знакомо с этим парсером. С сегодняшнего дня он перестал парсить таблицы чемпов в связи с обновлением всех лайвскор сайтов.
Может есть умельцы которые смогли бы его починить, не думаю что там сильно поменялся код.
Или есть к кому обратиться? Нужен знающий человек. Алгоритмы нафиг не нужны, они не работают, нужна только статистика по играм.

Sub getGame(id As String)
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Application.EnableEvents = False
    Application.StatusBar = False
    timezone = Sheets("Старт").Range("T2").Value - 1
    sourcer = Sheets("Старт").Range("X2").Value
If sourcer = 1 Then
        sourcer = "flashscore.com/"
        suffix = "_en_1_"
    ElseIf sourcer = 2 Then
        sourcer = "soccerstand.com/"
        suffix = "_en_1_"
    ElseIf sourcer = 3 Then
        sourcer = "soccerstand.com/ru/"
        suffix = "_ru_1"
    ElseIf sourcer = 4 Then
        sourcer = "myscore.ru/"
        suffix = "_ru_1"
    ElseIf sourcer = 5 Then
        sourcer = "myscore.com.ua/"
        suffix = "_ru_1"
    End If
    clearParsed
    'Get Teams ID
    Set http = CreateObject("MSXML2.XMLHTTP")
        http.Open "GET", "https://www." & sourcer & "match/" & id & "/", False
    http.Send
    fs_input = http.ResponseText
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Pattern = "participantEncodedIds = [\'(.*)\',\'(.*)\']"
    If objRegExp.test(fs_input) = True Then
        Set objMatches = objRegExp.Execute(fs_input)
        ActiveCell.Offset(, -2).Value = objMatches.Item(0).submatches(0)
        ActiveCell.Offset(, -1).Value = objMatches.Item(0).submatches(1)
        home_id = objMatches.Item(0).submatches(0)
        away_id = objMatches.Item(0).submatches(1)
        country_id = ActiveCell.Offset(, -3).Value
    End If
    objRegExp.Pattern = "tournamentStageEncodedId = \'(.*?)\'"
    If objRegExp.test(fs_input) = True Then
        Set objMatches = objRegExp.Execute(fs_input)
        tournament_stage_id = objMatches.Item(0).submatches(0)
    End If
    objRegExp.Pattern = "tournamentEncodedId = \'(.*?)\'"
    If objRegExp.test(fs_input) = True Then
        Set objMatches = objRegExp.Execute(fs_input)
        tournament_id = objMatches.Item(0).submatches(0)
    End If
    
    a = 2 'Get H2H
    Sheets("Очные").Range("A1").Value = ActiveCell.Offset(, -6).Value
    Sheets("Очные").Range("B1").Value = ActiveCell.Offset(, -5).Value
    Sheets("ОчныеДГ").Range("A1").Value = ActiveCell.Offset(, -6).Value
    Sheets("ОчныеДГ").Range("B1").Value = ActiveCell.Offset(, -5).Value
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://d." & sourcer & "x/feed/d_hh_" & id & suffix, False
    http.setRequestHeader "X-Fsign", "SW9D1eZo"
    http.Send
    fs_input = http.ResponseText
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True
    objRegExp.MultiLine = False
    objRegExp.Pattern = Chr(9)
    fs_input = objRegExp.Replace(fs_input, "")
    objRegExp.Pattern = Chr(10)
    fs_input = objRegExp.Replace(fs_input, "")
    objRegExp.Pattern = Chr(13)
    fs_input = objRegExp.Replace(fs_input, "")
    objRegExp.Pattern = "<table class=" & Chr(34) & "head_to_head h2h_mutual" & Chr(34) & ">(.*?)<\/table>"
    If objRegExp.test(fs_input) = True Then
        Set objMatches = objRegExp.Execute(fs_input)
        fs_input = objMatches.Item(0).submatches(0)
        objRegExp.Pattern = "<span class=" & Chr(34) & "date" & Chr(34) & ">(.*?)<\/span>(.*?)title=" & Chr(34) & "(.*?)" & Chr(34) & "(.*?)class=" & Chr(34) & "name" & Chr(34) & "><span>(.*?)<\/span><\/td><td class=" & Chr(34) & "name" & Chr(34) & "><span>(.*?)<\/span>(.*?)<strong>(.*?) : (.*?)<\/strong>"
        If objRegExp.test(fs_input) = True Then
            Set objMatches = objRegExp.Execute(fs_input)
            cntx = objMatches.Count
            Call Show_PrBar_Or_No(cntx, "Загрузка очных...")
            For Each m In objMatches
                If bShowBar Then Call MyProgresBar
                objRegExp.Pattern = "<strong>"
                m_home = objRegExp.Replace(m.submatches(4), "")
                m_away = objRegExp.Replace(m.submatches(5), "")
                objRegExp.Pattern = "<\/strong>"
                m_home = objRegExp.Replace(m_home, "")
                m_away = objRegExp.Replace(m_away, "")
                m_date = DateAdd("s", m.submatches(0), "01/01/1970")
                date_match = DateAdd("h", timezone, date_match)
                m_date = Format(m_date, "yyyy.mm.dd")
                If m_date = Format(Now, "yyyy.mm.dd") Or m_date = Format(Now - 1, "yyyy.mm.dd") Then
                Else
                Set objRegExp = CreateObject("VBScript.RegExp")
                objRegExp.Pattern = "\s\(...\)"
                m_home = objRegExp.Replace(m_home, "")
                m_away = objRegExp.Replace(m_away, "")
                    Sheets("Очные").Range("A" & a).Value = m.submatches(2)
                    Sheets("Очные").Range("B" & a).Value = Format(m_date, "yyyy.mm.dd hh:mm")
                    Sheets("Очные").Range("C" & a).Value = m_home
                    Sheets("Очные").Range("D" & a).Value = m_away
                    Sheets("Очные").Range("E" & a).Value = m.submatches(7)
                    Sheets("Очные").Range("F" & a).Value = m.submatches(8)
                    If m_home = Sheets("Очные").Range("A1").Value Then
                        Sheets("ОчныеДГ").Range("A" & a).Value = m.submatches(2)
                        m_date = DateAdd("s", m.submatches(0), "01/01/1970")
                        Sheets("ОчныеДГ").Range("B" & a).Value = Format(m_date, "yyyy.mm.dd hh:mm")
                        Sheets("ОчныеДГ").Range("C" & a).Value = m_home
                        Sheets("ОчныеДГ").Range("D" & a).Value = m_away
                        Sheets("ОчныеДГ").Range("E" & a).Value = m.submatches(7)
                        Sheets("ОчныеДГ").Range("F" & a).Value = m.submatches(8)
                    End If
                    a = a + 1
                End If
            Next
            If bShowBar Then Unload frmStatusBar
        End If
    End If
    Sheets("Очные").Range("A:F").Sort Key1:=Sheets("Очные").Columns("B"), Header:=xlYes, Order1:=xlDescending
    Sheets("ОчныеДГ").Range("A:F").Sort Key1:=Sheets("ОчныеДГ").Columns("B"), Header:=xlYes, Order1:=xlDescending
    
    a = 2 'Get Home Matches
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://d." & sourcer & "x/feed/pr_1_" & country_id & "_" & home_id & "_0_0_ru_1", False
    http.setRequestHeader "X-Fsign", "SW9D1eZo"
    http.Send
    fs_input = http.ResponseText
    fs_rows = Split(fs_input, "~")
    fs_rows_length = UBound(fs_rows) - LBound(fs_rows)
    Call Show_PrBar_Or_No(fs_rows_length, "Загрузка домашних...")
    For i = 0 To fs_rows_length - 4
        If bShowBar Then Call MyProgresBar
        fs_row = Split(fs_rows(i), "¬")
        fs_row_length = UBound(fs_row) - LBound(fs_row)
        fs_index = Split(fs_row(0), ChrW(&HF7))
        If IsArray(fs_index) Then
            fs_index_name = fs_index(0)
            fs_index_value = fs_index(1)
        End If
        If fs_index_name = "SA" Then
            sport_id = fs_index_value
        ElseIf fs_index_name = "ZA" Then
            tour_name = ""
            home_name = ""
            For j = 0 To fs_row_length - 1
                fs_row_parts = Split(fs_row(j), ChrW(&HF7))
                If fs_row_parts(0) = "ZA" Then tour_name = fs_row_parts(1)
                If fs_row_parts(0) = "ZB" Then country_id = fs_row_parts(1)
            Next j
        ElseIf fs_index_name = "AA" Then
            home_name = ""
            For j = 0 To fs_row_length - 1
                fs_row_parts = Split(fs_row(j), ChrW(&HF7))
                If fs_row_parts(0) = "AA" Then match_id = fs_row_parts(1)
                If fs_row_parts(0) = "AD" Then
                    date_match = DateAdd("s", fs_row_parts(1), "01/01/1970")
                    date_match = DateAdd("h", timezone, date_match)
                    date_match = Format(date_match, "yyyy.mm.dd hh:mm")
                End If
                If fs_row_parts(0) = "AE" Then home_name = fs_row_parts(1)
                If fs_row_parts(0) = "AF" Then away_name = fs_row_parts(1)
                If fs_row_parts(0) = "BA" Then home_first = fs_row_parts(1)
                If fs_row_parts(0) = "BB" Then away_first = fs_row_parts(1)
                If fs_row_parts(0) = "BC" Then home_second = fs_row_parts(1)
                If fs_row_parts(0) = "BD" Then away_second = fs_row_parts(1)
                If fs_row_parts(0) = "PX" Then home_id2 = fs_row_parts(1)
            Next j
            If fs_index_value = id Then home_name = ""
        End If
        If tour_name = "" Or home_name = "" Then
        Else
            Set objRegExp = CreateObject("VBScript.RegExp")
            objRegExp.Pattern = "\s\(...\)"
            home_name = objRegExp.Replace(home_name, "")
            away_name = objRegExp.Replace(away_name, "")
            Sheets("Дома").Range("A" & a).Value = tour_name
            Sheets("Дома").Range("B" & a).Value = date_match
            Sheets("Дома").Range("C" & a).Value = home_name
            Sheets("Дома").Range("D" & a).Value = away_name
            Sheets("Дома").Range("E" & a).Value = home_first
            Sheets("Дома").Range("F" & a).Value = away_first
            Sheets("Дома").Range("G" & a).Value = home_second
            Sheets("Дома").Range("H" & a).Value = away_second
            If home_id2 = home_id Then
                Sheets("Дома").Range("I" & a).Value = "Дома"
                Sheets("ДомаДома").Range("A" & a).Value = tour_name
                Sheets("ДомаДома").Range("B" & a).Value = date_match
                Sheets("ДомаДома").Range("C" & a).Value = home_name
                Sheets("ДомаДома").Range("D" & a).Value = away_name
                Sheets("ДомаДома").Range("E" & a).Value = home_first
                Sheets("ДомаДома").Range("F" & a).Value = away_first
                Sheets("ДомаДома").Range("G" & a).Value = home_second
                Sheets("ДомаДома").Range("H" & a).Value = away_second
                Sheets("ДомаДома").Range("I" & a).Value = "Дома"
            Else
                Sheets("Дома").Range("I" & a).Value = "Гости"
                Sheets("ДомаГости").Range("A" & a).Value = tour_name
                Sheets("ДомаГости").Range("B" & a).Value = date_match
                Sheets("ДомаГости").Range("C" & a).Value = home_name
                Sheets("ДомаГости").Range("D" & a).Value = away_name
                Sheets("ДомаГости").Range("E" & a).Value = home_first
                Sheets("ДомаГости").Range("F" & a).Value = away_first
                Sheets("ДомаГости").Range("G" & a).Value = home_second
                Sheets("ДомаГости").Range("H" & a).Value = away_second
                Sheets("ДомаГости").Range("I" & a).Value = "Гости"
            End If
            a = a + 1
        End If
    Next i
    If bShowBar Then Unload frmStatusBar
    Sheets("Дома").Range("A:I").Sort Key1:=Sheets("Дома").Columns("B"), Header:=xlYes, Order1:=xlDescending
    Sheets("ДомаДома").Range("A:I").Sort Key1:=Sheets("ДомаДома").Columns("B"), Header:=xlYes, Order1:=xlDescending
    Sheets("ДомаГости").Range("A:I").Sort Key1:=Sheets("ДомаГости").Columns("B"), Header:=xlYes, Order1:=xlDescending
    
    a = 2 'Get Away Macthes
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://d." & sourcer & "x/feed/pr_1_" & country_id & "_" & away_id & "_0_0_ru_1", False
    http.setRequestHeader "X-Fsign", "SW9D1eZo"
    http.Send
    fs_input = http.ResponseText
    fs_rows = Split(fs_input, "~")
    fs_rows_length = UBound(fs_rows) - LBound(fs_rows)
    Call Show_PrBar_Or_No(fs_rows_length, "Загрузка гостевых...")
    For i = 0 To fs_rows_length - 4
        If bShowBar Then Call MyProgresBar
        fs_row = Split(fs_rows(i), "¬")
        fs_row_length = UBound(fs_row) - LBound(fs_row)
        fs_index = Split(fs_row(0), ChrW(&HF7))
        If IsArray(fs_index) Then
            fs_index_name = fs_index(0)
            fs_index_value = fs_index(1)
        End If
        If fs_index_name = "SA" Then
            sport_id = fs_index_value
        ElseIf fs_index_name = "ZA" Then
            tour_name = ""
            home_name = ""
            For j = 0 To fs_row_length - 1
                fs_row_parts = Split(fs_row(j), ChrW(&HF7))
                If fs_row_parts(0) = "ZA" Then tour_name = fs_row_parts(1)
                If fs_row_parts(0) = "ZB" Then country_id = fs_row_parts(1)
            Next j
        ElseIf fs_index_name = "AA" Then
            home_name = ""
            For j = 0 To fs_row_length - 1
                fs_row_parts = Split(fs_row(j), ChrW(&HF7))
                If fs_row_parts(0) = "AA" Then match_id = fs_row_parts(1)
                If fs_row_parts(0) = "AD" Then
                    date_match = DateAdd("s", fs_row_parts(1), "01/01/1970")
                    date_match = DateAdd("h", timezone, date_match)
                    date_match = Format(date_match, "yyyy.mm.dd hh:mm")
                End If
                If fs_row_parts(0) = "AE" Then home_name = fs_row_parts(1)
                If fs_row_parts(0) = "AF" Then away_name = fs_row_parts(1)
                If fs_row_parts(0) = "BA" Then home_first = fs_row_parts(1)
                If fs_row_parts(0) = "BB" Then away_first = fs_row_parts(1)
                If fs_row_parts(0) = "BC" Then home_second = fs_row_parts(1)
                If fs_row_parts(0) = "BD" Then away_second = fs_row_parts(1)
                If fs_row_parts(0) = "PY" Then away_id2 = fs_row_parts(1)
            Next j
            If fs_index_value = id Then home_name = ""
        End If
        If tour_name = "" Or home_name = "" Then
        Else
            Set objRegExp = CreateObject("VBScript.RegExp")
            objRegExp.Pattern = "\s\(...\)"
            home_name = objRegExp.Replace(home_name, "")
            away_name = objRegExp.Replace(away_name, "")
            Sheets("Гости").Range("A" & a).Value = tour_name
            Sheets("Гости").Range("B" & a).Value = date_match
            Sheets("Гости").Range("C" & a).Value = home_name
            Sheets("Гости").Range("D" & a).Value = away_name
            Sheets("Гости").Range("E" & a).Value = home_first
            Sheets("Гости").Range("F" & a).Value = away_first
            Sheets("Гости").Range("G" & a).Value = home_second
            Sheets("Гости").Range("H" & a).Value = away_second
            If away_id2 = away_id Then
                Sheets("Гости").Range("I" & a).Value = "Гости"
                Sheets("ГостиГости").Range("A" & a).Value = tour_name
                Sheets("ГостиГости").Range("B" & a).Value = date_match
                Sheets("ГостиГости").Range("C" & a).Value = home_name
                Sheets("ГостиГости").Range("D" & a).Value = away_name
                Sheets("ГостиГости").Range("E" & a).Value = home_first
                Sheets("ГостиГости").Range("F" & a).Value = away_first
                Sheets("ГостиГости").Range("G" & a).Value = home_second
                Sheets("ГостиГости").Range("H" & a).Value = away_second
                Sheets("ГостиГости").Range("I" & a).Value = "Гости"
            Else
                Sheets("Гости").Range("I" & a).Value = "Дома"
                Sheets("ГостиДома").Range("A" & a).Value = tour_name
                Sheets("ГостиДома").Range("B" & a).Value = date_match
                Sheets("ГостиДома").Range("C" & a).Value = home_name
                Sheets("ГостиДома").Range("D" & a).Value = away_name
                Sheets("ГостиДома").Range("E" & a).Value = home_first
                Sheets("ГостиДома").Range("F" & a).Value = away_first
                Sheets("ГостиДома").Range("G" & a).Value = home_second
                Sheets("ГостиДома").Range("H" & a).Value = away_second
                Sheets("ГостиДома").Range("I" & a).Value = "Дома"
            End If
            a = a + 1
        End If
    Next i
    If bShowBar Then Unload frmStatusBar
    Sheets("Гости").Range("A:I").Sort Key1:=Sheets("Гости").Columns("B"), Header:=xlYes, Order1:=xlDescending
    Sheets("ГостиДома").Range("A:I").Sort Key1:=Sheets("ГостиДома").Columns("B"), Header:=xlYes, Order1:=xlDescending
    Sheets("ГостиГости").Range("A:I").Sort Key1:=Sheets("ГостиГости").Columns("B"), Header:=xlYes, Order1:=xlDescending
    
    a = 2 'Get Table
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id & "_" & tournament_stage_id & "_table_overall?hp1=" & home_id & "&hp2=" & away_id & "&e=" & id, False
    http.setRequestHeader "X-Fsign", "SW9D1eZo"
    http.Send
    fs_input = http.ResponseText
    'MsgBox fs_input
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True
    objRegExp.MultiLine = False
    objRegExp.Pattern = Chr(9)
    fs_input = objRegExp.Replace(fs_input, "")
    objRegExp.Pattern = Chr(10)
    fs_input = objRegExp.Replace(fs_input, "")
    objRegExp.Pattern = Chr(13)
    fs_input = objRegExp.Replace(fs_input, "")
    If InStr(1, fs_input, "col_wins_pen") = 0 And InStr(1, fs_input, "col_wins_ot") = 0 Then
        objRegExp.Pattern = "<tr(.*?)>([0-9]+)\.<(.*?)>(.*?)team_name_span(.*?)>(.*?)>(.*?)<(.*?)col_matches_played(.*?)>(.*?)<(.*?)wins(.*?)>(.*?)<(.*?)draws(.*?)>(.*?)<(.*?)losses(.*?)>(.*?)<(.*?)goals(.*?)>(.*?):(.*?)<(.*?)points(.*?)>(.*?)<\/td>"
    If objRegExp.test(fs_input) = True Then
        Set objMatches = objRegExp.Execute(fs_input)
        cntx = objMatches.Count
        Call Show_PrBar_Or_No(cntx, "Загрузка таблицы Общая...")
        For Each m In objMatches
            If bShowBar Then Call MyProgresBar
            Sheets("Таблица").Range("A" & a).Value = m.submatches(1)
            Sheets("Таблица").Range("B" & a).Value = m.submatches(6)
            Sheets("Таблица").Range("C" & a).Value = m.submatches(9)
            Sheets("Таблица").Range("D" & a).Value = m.submatches(12)
            Sheets("Таблица").Range("E" & a).Value = m.submatches(15)
            Sheets("Таблица").Range("F" & a).Value = m.submatches(18)
            Sheets("Таблица").Range("G" & a).Value = m.submatches(21)
            Sheets("Таблица").Range("H" & a).Value = m.submatches(22)
            Sheets("Таблица").Range("I" & a).Value = m.submatches(25)
            a = a + 1
        Next
        If bShowBar Then Unload frmStatusBar
        End If
    End If
    a = 2
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id & "_" & tournament_stage_id & "_table_home?hp1=" & home_id & "&hp2=" & away_id & "&e=" & id, False
    http.setRequestHeader "X-Fsign", "SW9D1eZo"
    http.Send
    fs_input = http.ResponseText
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True
    objRegExp.MultiLine = False
    objRegExp.Pattern = Chr(9)
    fs_input = objRegExp.Replace(fs_input, "")
    objRegExp.Pattern = Chr(10)
    fs_input = objRegExp.Replace(fs_input, "")
    objRegExp.Pattern = Chr(13)
    fs_input = objRegExp.Replace(fs_input, "")
    If InStr(1, fs_input, "col_wins_pen") = 0 And InStr(1, fs_input, "col_wins_ot") = 0 Then
    objRegExp.Pattern = "<tr(.*?)>([0-9]+)\.<(.*?)>(.*?)team_name_span(.*?)>(.*?)>(.*?)<(.*?)col_matches_played(.*?)>(.*?)<(.*?)wins(.*?)>(.*?)<(.*?)draws(.*?)>(.*?)<(.*?)losses(.*?)>(.*?)<(.*?)goals(.*?)>(.*?):(.*?)<(.*?)points(.*?)>(.*?)<\/td>"
    If objRegExp.test(fs_input) = True Then
        Set objMatches = objRegExp.Execute(fs_input)
        cntx = objMatches.Count
        Call Show_PrBar_Or_No(cntx, "Загрузка таблицы Дома...")
        For Each m In objMatches
            If bShowBar Then Call MyProgresBar
            Sheets("Таблица").Range("K" & a).Value = m.submatches(1)
            Sheets("Таблица").Range("L" & a).Value = m.submatches(6)
            Sheets("Таблица").Range("M" & a).Value = m.submatches(9)
            Sheets("Таблица").Range("N" & a).Value = m.submatches(12)
            Sheets("Таблица").Range("O" & a).Value = m.submatches(15)
            Sheets("Таблица").Range("P" & a).Value = m.submatches(18)
            Sheets("Таблица").Range("Q" & a).Value = m.submatches(21)
            Sheets("Таблица").Range("R" & a).Value = m.submatches(22)
            Sheets("Таблица").Range("S" & a).Value = m.submatches(25)
            a = a + 1
        Next
        If bShowBar Then Unload frmStatusBar
        End If
    End If
    a = 2
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id & "_" & tournament_stage_id & "_table_away?hp1=" & home_id & "&hp2=" & away_id & "&e=" & id, False
    http.setRequestHeader "X-Fsign", "SW9D1eZo"
    http.Send
    fs_input = http.ResponseText
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True
    objRegExp.MultiLine = False
    objRegExp.Pattern = Chr(9)
    fs_input = objRegExp.Replace(fs_input, "")
    objRegExp.Pattern = Chr(10)
    fs_input = objRegExp.Replace(fs_input, "")
    objRegExp.Pattern = Chr(13)
    fs_input = objRegExp.Replace(fs_input, "")
    If InStr(1, fs_input, "col_wins_pen") = 0 And InStr(1, fs_input, "col_wins_ot") = 0 Then
    objRegExp.Pattern = "<tr(.*?)>([0-9]+)\.<(.*?)>(.*?)team_name_span(.*?)>(.*?)>(.*?)<(.*?)col_matches_played(.*?)>(.*?)<(.*?)wins(.*?)>(.*?)<(.*?)draws(.*?)>(.*?)<(.*?)losses(.*?)>(.*?)<(.*?)goals(.*?)>(.*?):(.*?)<(.*?)points(.*?)>(.*?)<\/td>"
    If objRegExp.test(fs_input) = True Then
        Set objMatches = objRegExp.Execute(fs_input)
        cntx = objMatches.Count
        Call Show_PrBar_Or_No(cntx, "Загрузка таблицы Гости...")
        For Each m In objMatches
            If bShowBar Then Call MyProgresBar
            Sheets("Таблица").Range("U" & a).Value = m.submatches(1)
            Sheets("Таблица").Range("V" & a).Value = m.submatches(6)
            Sheets("Таблица").Range("W" & a).Value = m.submatches(9)
            Sheets("Таблица").Range("X" & a).Value = m.submatches(12)
            Sheets("Таблица").Range("Y" & a).Value = m.submatches(15)
            Sheets("Таблица").Range("Z" & a).Value = m.submatches(18)
            Sheets("Таблица").Range("AA" & a).Value = m.submatches(21)
            Sheets("Таблица").Range("AB" & a).Value = m.submatches(22)
            Sheets("Таблица").Range("AC" & a).Value = m.submatches(25)
            a = a + 1
        Next
        If bShowBar Then Unload frmStatusBar
        End If
    End If
    a = 2 'Get Form
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id & "_" & tournament_stage_id & "_form_overall?hp1=" & home_id & "&hp2=" & away_id & "&e=" & id, False
    http.setRequestHeader "X-Fsign", "SW9D1eZo"
    http.Send
    fs_input = http.ResponseText
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True
    objRegExp.MultiLine = False
    objRegExp.Pattern = Chr(9)
    fs_input = objRegExp.Replace(fs_input, "")
    objRegExp.Pattern = Chr(10)
    fs_input = objRegExp.Replace(fs_input, "")
    objRegExp.Pattern = Chr(13)
    fs_input = objRegExp.Replace(fs_input, "")
    If InStr(1, fs_input, "col_wins_pen") = 0 And InStr(1, fs_input, "col_wins_ot") = 0 Then
    objRegExp.Pattern = "<tr(.*?)>([0-9]+)\.<(.*?)>(.*?)team_name_span(.*?)>(.*?)>(.*?)<(.*?)col_matches_played(.*?)>(.*?)<(.*?)wins(.*?)>(.*?)<(.*?)draws(.*?)>(.*?)<(.*?)losses(.*?)>(.*?)<(.*?)goals(.*?)>(.*?):(.*?)<(.*?)points(.*?)>(.*?)<\/td>"
    If objRegExp.test(fs_input) = True Then
        Set objMatches = objRegExp.Execute(fs_input)
        cntx = objMatches.Count
        Call Show_PrBar_Or_No(cntx, "Загрузка формы Общая...")
        For Each m In objMatches
            If bShowBar Then Call MyProgresBar
            Sheets("Форма").Range("A" & a).Value = m.submatches(1)
            Sheets("Форма").Range("B" & a).Value = m.submatches(6)
            Sheets("Форма").Range("C" & a).Value = m.submatches(9)
            Sheets("Форма").Range("D" & a).Value = m.submatches(12)
            Sheets("Форма").Range("E" & a).Value = m.submatches(15)
            Sheets("Форма").Range("F" & a).Value = m.submatches(18)
            Sheets("Форма").Range("G" & a).Value = m.submatches(21)
            Sheets("Форма").Range("H" & a).Value = m.submatches(22)
            Sheets("Форма").Range("I" & a).Value = m.submatches(25)
            a = a + 1
        Next
        If bShowBar Then Unload frmStatusBar
        End If
    End If
    a = 2
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id & "_" & tournament_stage_id & "_form_home?hp1=" & home_id & "&hp2=" & away_id & "&e=" & id, False
    http.setRequestHeader "X-Fsign", "SW9D1eZo"
    http.Send
    fs_input = http.ResponseText
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True
    objRegExp.MultiLine = False
    objRegExp.Pattern = Chr(9)
    fs_input = objRegExp.Replace(fs_input, "")
    objRegExp.Pattern = Chr(10)
    fs_input = objRegExp.Replace(fs_input, "")
    objRegExp.Pattern = Chr(13)
    fs_input = objRegExp.Replace(fs_input, "")
    If InStr(1, fs_input, "col_wins_pen") = 0 And InStr(1, fs_input, "col_wins_ot") = 0 Then
    objRegExp.Pattern = "<tr(.*?)>([0-9]+)\.<(.*?)>(.*?)team_name_span(.*?)>(.*?)>(.*?)<(.*?)col_matches_played(.*?)>(.*?)<(.*?)wins(.*?)>(.*?)<(.*?)draws(.*?)>(.*?)<(.*?)losses(.*?)>(.*?)<(.*?)goals(.*?)>(.*?):(.*?)<(.*?)points(.*?)>(.*?)<\/td>"
    If objRegExp.test(fs_input) = True Then
        Set objMatches = objRegExp.Execute(fs_input)
        cntx = objMatches.Count
        Call Show_PrBar_Or_No(cntx, "Загрузка формы Дома...")
        For Each m In objMatches
            If bShowBar Then Call MyProgresBar
            Sheets("Форма").Range("K" & a).Value = m.submatches(1)
            Sheets("Форма").Range("L" & a).Value = m.submatches(6)
            Sheets("Форма").Range("M" & a).Value = m.submatches(9)
            Sheets("Форма").Range("N" & a).Value = m.submatches(12)
            Sheets("Форма").Range("O" & a).Value = m.submatches(15)
            Sheets("Форма").Range("P" & a).Value = m.submatches(18)
            Sheets("Форма").Range("Q" & a).Value = m.submatches(21)
            Sheets("Форма").Range("R" & a).Value = m.submatches(22)
            Sheets("Форма").Range("S" & a).Value = m.submatches(25)
            a = a + 1
        Next
        If bShowBar Then Unload frmStatusBar
        End If
    End If
    a = 2
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id & "_" & tournament_stage_id & "_form_away?hp1=" & home_id & "&hp2=" & away_id & "&e=" & id, False
    http.setRequestHeader "X-Fsign", "SW9D1eZo"
    http.Send
    fs_input = http.ResponseText
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True
    objRegExp.MultiLine = False
    objRegExp.Pattern = Chr(9)
    fs_input = objRegExp.Replace(fs_input, "")
    objRegExp.Pattern = Chr(10)
    fs_input = objRegExp.Replace(fs_input, "")
    objRegExp.Pattern = Chr(13)
    fs_input = objRegExp.Replace(fs_input, "")
    If InStr(1, fs_input, "col_wins_pen") = 0 And InStr(1, fs_input, "col_wins_ot") = 0 Then
    objRegExp.Pattern = "<tr(.*?)>([0-9]+)\.<(.*?)>(.*?)team_name_span(.*?)>(.*?)>(.*?)<(.*?)col_matches_played(.*?)>(.*?)<(.*?)wins(.*?)>(.*?)<(.*?)draws(.*?)>(.*?)<(.*?)losses(.*?)>(.*?)<(.*?)goals(.*?)>(.*?):(.*?)<(.*?)points(.*?)>(.*?)<\/td>"
    If objRegExp.test(fs_input) = True Then
        Set objMatches = objRegExp.Execute(fs_input)
        cntx = objMatches.Count
        Call Show_PrBar_Or_No(cntx, "Загрузка формы Гости...")
        For Each m In objMatches
            If bShowBar Then Call MyProgresBar
            Sheets("Форма").Range("U" & a).Value = m.submatches(1)
            Sheets("Форма").Range("V" & a).Value = m.submatches(6)
            Sheets("Форма").Range("W" & a).Value = m.submatches(9)
            Sheets("Форма").Range("X" & a).Value = m.submatches(12)
            Sheets("Форма").Range("Y" & a).Value = m.submatches(15)
            Sheets("Форма").Range("Z" & a).Value = m.submatches(18)
            Sheets("Форма").Range("AA" & a).Value = m.submatches(21)
            Sheets("Форма").Range("AB" & a).Value = m.submatches(22)
            Sheets("Форма").Range("AC" & a).Value = m.submatches(15)
            a = a + 1
        Next
        If bShowBar Then Unload frmStatusBar
        End If
    End If
    getOdds (id)
    Sheets("Расчеты").Range("A1").Value = id

    Sheets("Анализ").Select
        Application.ScreenUpdating = True
        Application.Calculation = xlAutomatic
        Application.EnableEvents = True
        Application.StatusBar = True
End Sub

[x]

Вот ссылка

[DimOK]

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

[x]

ура, починили! можно удалять

[Lardom]

Этим парсером можно поделиться? Был бы благодарен.

[paradox]

Oddsportal тоже обновился?

[x]

@lardom да пожалуйста) - прога

[x]

@paradox вроде нет

[x]

@dimok этот самый простой, есть реально монстры)) у меня есть один: парсит одспортал(какие хочешь бк и виды ставок можно задать), тащит xg c другого сайта + составы. всё эксель) но долго.

[DimOK]

Ну можно сделать простейшую программку, которая будет нормально всё парсить и тащить и выводить в красивом интерфейсе.
Это намного проще, чем извращаться с экселем.

[cool]

Вы не боитесь что через подобные программы вы можете предоставить доступ к своему ПК.
Может в этом ответ почему какой то EXCEL а не вполне себе работоспособные программы на каком нибудь Python?

[DimOK]

Подобные программы надо на удалённых серверах запускать и оставлять там постоянно работать, тогда и данные будут свежие и доступ откуда угодно.

[x]

@cool что мешает если страшно запустить на другом компе и просмотреть макросы.
программы конечно разные бывают, именно за этот файл не ручаюсь, попросили скинуть - скинул. у меня на базе этого парсер, но алгоритмы свои, и я там знаю всё вдоль и поперёк.

Ну и конечно когда пользуетесь софтом непонятного происхождения, то лучше не держать там парольные фразы от крипты)

[x]

@cool если вы считаете эксель "каким-то", то вы просто ничего о нём не знаете

[Gambit365]

Hi i have a file similar in code but structure is a bit different ,it calculates probabilities as it goes through each match.But the problem is the same because of changes it can not get the leagues aswellBetFile.rar

[Gambit365]

File uploaded with my previous post

[Gambit365]

this piece of code has recently stopped working hope someone can fix.
этот фрагмент кода недавно перестал работать, надеюсь, кто-нибудь сможет исправить.

'Get Home Matches

rowindx = 2
 Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
oXMLHTTP.Open "GET", "https://d." & Sourcer & "x/feed/pr_1_" & country_id & "_" & participantEncodedIds1 & "_0_0_ru_1", False
oXMLHTTP.setRequestHeader "X-Fsign", "SW9D1eZo"
oXMLHTTP.Send
response = oXMLHTTP.ResponseText
fs_rows = Split(response, "~")
fs_rows_length = UBound(fs_rows) - LBound(fs_rows)
Call Show_PrBar_Or_No(fs_rows_length, "Loading home ...")
For i = 0 To fs_rows_length - 4
    If bShowBar Then Call MyProgresBar
    fs_row = Split(fs_rows(i), "¬")
    fs_row_length = UBound(fs_row) - LBound(fs_row)
    fs_index = Split(fs_row(0), ChrW(&HF7))
    If IsArray(fs_index) Then
        fs_index_name = fs_index(0)
        fs_index_value = fs_index(1)
    End If
    If fs_index_name = "SA" Then
        sport_id = fs_index_value
    ElseIf fs_index_name = "ZA" Then
        tour_name = ""
        home_name = ""
        For J = 0 To fs_row_length - 1
            fs_row_parts = Split(fs_row(J), ChrW(&HF7))
            If fs_row_parts(0) = "ZA" Then tour_name = fs_row_parts(1)
            If fs_row_parts(0) = "ZB" Then country_id = fs_row_parts(1)
            If fs_row_parts(0) = "ZC" Then tour_id = fs_row_parts(1)
        Next J
    ElseIf fs_index_name = "AA" Then
        home_name = ""
        For J = 0 To fs_row_length - 1
            fs_row_parts = Split(fs_row(J), ChrW(&HF7))
            If fs_row_parts(0) = "AA" Then match_id = fs_row_parts(1)
            If fs_row_parts(0) = "AD" Then
                date_match = DateAdd("s", fs_row_parts(1), "01/01/1970")
                date_match = DateAdd("h", timezone, date_match)
                date_match = Format(date_match, "yyyy.mm.dd hh:mm")
            End If
            If fs_row_parts(0) = "AA" Then idios = fs_row_parts(1)
            If fs_row_parts(0) = "AE" Then home_name = fs_row_parts(1)
            If fs_row_parts(0) = "AF" Then away_name = fs_row_parts(1)
            If fs_row_parts(0) = "BA" Then home_first = fs_row_parts(1)
            If fs_row_parts(0) = "BB" Then away_first = fs_row_parts(1)
            If fs_row_parts(0) = "BC" Then home_second = fs_row_parts(1)
            If fs_row_parts(0) = "BD" Then away_second = fs_row_parts(1)
            If fs_row_parts(0) = "PX" Then participantEncodedIds12 = fs_row_parts(1)
        Set oRegExp = CreateObject("VBScript.RegExp")
        oRegExp.Pattern = "\s\(...\)"
        home_name = oRegExp.Replace(home_name, "")
        away_name = oRegExp.Replace(away_name, "")
        
        Next J
        'If fs_index_value = id Then home_name = ""
    End If
    If tour_name = "" Or home_name = "" Then
    Else
        Sheets("Athome").Range("A" & rowindx).Value = tour_name
        Sheets("Athome").Range("B" & rowindx).Value = date_match
        Sheets("Athome").Range("C" & rowindx).Value = home_name
        Sheets("Athome").Range("D" & rowindx).Value = away_name
        Sheets("Athome").Range("E" & rowindx).Value = home_first
        Sheets("Athome").Range("F" & rowindx).Value = away_first
        Sheets("Athome").Range("G" & rowindx).Value = home_second
        Sheets("Athome").Range("H" & rowindx).Value = away_second
        If participantEncodedIds12 = participantEncodedIds1 Then
            Sheets("Athome").Range("I" & rowindx).Value = "Athome"
            Sheets("Athome2").Range("A" & rowindx).Value = tour_name
            Sheets("Athome2").Range("B" & rowindx).Value = date_match
            Sheets("Athome2").Range("C" & rowindx).Value = home_name
            Sheets("Athome2").Range("D" & rowindx).Value = away_name
            Sheets("Athome2").Range("E" & rowindx).Value = home_first
            Sheets("Athome2").Range("F" & rowindx).Value = away_first
            Sheets("Athome2").Range("G" & rowindx).Value = home_second
            Sheets("Athome2").Range("H" & rowindx).Value = away_second
            Sheets("Athome2").Range("I" & rowindx).Value = "Athome"
        Else
            Sheets("Athome").Range("I" & rowindx).Value = "Guests"
            Sheets("Athome3").Range("A" & rowindx).Value = tour_name
            Sheets("Athome3").Range("B" & rowindx).Value = date_match
            Sheets("Athome3").Range("C" & rowindx).Value = home_name
            Sheets("Athome3").Range("D" & rowindx).Value = away_name
            Sheets("Athome3").Range("E" & rowindx).Value = home_first
            Sheets("Athome3").Range("F" & rowindx).Value = away_first
            Sheets("Athome3").Range("G" & rowindx).Value = home_second
            Sheets("Athome3").Range("H" & rowindx).Value = away_second
            Sheets("Athome3").Range("I" & rowindx).Value = "Guests"
        End If
        rowindx = rowindx + 1
    End If
Next i
If bShowBar Then Unload frmStatusBar
Sheets("Athome").Range("A:I").Sort Key1:=Sheets("Athome").Columns("B"), Header:=xlYes, Order1:=xlDescending
Sheets("Athome2").Range("A:I").Sort Key1:=Sheets("Athome2").Columns("B"), Header:=xlYes, Order1:=xlDescending
Sheets("Athome3").Range("A:I").Sort Key1:=Sheets("Athome3").Columns("B"), Header:=xlYes, Order1:=xlDescending