Опубликовано 14 марта, 20242 г. 9 минут назад, Shurik91 сказал: попробуй ElseIf fs_index_name = "AA" Then first_home = "": first_away = "": second_home = "": second_away = "" 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) = "AT" Then first_home = fs_row_parts(1) If fs_row_parts(0) = "AU" Then first_away = fs_row_parts(1) If fs_row_parts(0) = "BC" Then second_home = fs_row_parts(1) If fs_row_parts(0) = "BD" Then second_away = fs_row_parts(1) If fs_row_parts(0) = "AB" Then status_game = fs_row_parts(1) If fs_row_parts(0) = "AC" Then status_game_code = fs_row_parts(1) Next j Set fcell = ThisWorkbook.Sheets("listing").Columns("E:E").Find(match_id) rowindx = CStr(fcell.Row) If status_game = 3 And (status_game_code = 3 Or status_game_code = 10 Or status_game_code = 11) And first_home <> "" And second_home <> "" Then Sheets("listing").Range("BI" & rowindx).Value = Val(first_home) - Val(second_home) & " : " & Val(first_away) - Val(second_away) Sheets("listing").Range("BJ" & rowindx).Value = first_home & " : " & first_away Спасибо огромное! Все отлично!
Опубликовано 14 марта, 20242 г. Постоянный 4 минуты назад, Lucky сказал: Спасибо огромное! Все отлично! Обязательно через поиск, поищите в коде, во всех модулях, индексы BA и BB, чтобы точно убедится, что индексы и расчёт, везде переделаны. Если этого не сделать, расчёты в таблице будут неверные. Обращаю внимание всех.
Опубликовано 14 марта, 20242 г. 7 минут назад, Shurik91 сказал: Обязательно через поиск, поищите в коде, во всех модулях, индексы BA и BB, чтобы точно убедится, что индексы и расчёт, везде переделаны. Если этого не сделать, расчёты в таблице будут неверные. Обращаю внимание всех. Уточняющий вопрос! Везде BA и BB заменить на AT и AU ???
Опубликовано 14 марта, 20242 г. 1 час назад, dchervyakov сказал: назовите сколько будет стоить? мод не выдает итоговый результат. он есть у меня.
Опубликовано 14 марта, 20242 г. Только что, Lucky сказал: Уточняющий вопрос! Везде BA и BB заменить на AT и AU ??? Так то вроде все правильно! Я имею ввиду по результатам!
Опубликовано 14 марта, 20242 г. 12 минут назад, Василий Ярандаев сказал: мод не выдает итоговый результат. он есть у меня. Да, итоговый результат не дает
Опубликовано 14 марта, 20242 г. Постоянный 7 минут назад, Lucky сказал: Уточняющий вопрос! Везде BA и BB заменить на AT и AU ??? например, Вы указали в поиске индекс BA и он подсветил, знакомый уже блок кода AA, AD ... BD, в каком-то из модулей, значит нужно заменить индексы на AT и AU, а также изменить расчёты, первого тайма и матча. Потом указали BB и повторили поиск по всем модулям. Я думаю понятно, что везде заменять BA и BB не нужно. Так как они могут отвечать за адрес ячейки на листе или быть переменными. Изменяйте только в блоке с индексами AA, AD ... BD
Опубликовано 14 марта, 20242 г. 8 минут назад, Shurik91 сказал: например, Вы указали в поиске индекс BA и он подсветил, знакомый уже блок кода AA, AD ... BD, в каком-то из модулей, значит нужно заменить индексы на AT и AU, а также изменить расчёты, первого тайма и матча. Потом указали BB и повторили поиск по всем модулям. Я думаю понятно, что везде заменять BA и BB не нужно. Так как они могут отвечать за адрес ячейки на листе или быть переменными. Изменяйте только в блоке с индексами AA, AD ... BD На сколько я понял в таком блоке их менять не нужно? ElseIf fs_index_name = "AA" Then first_home = "": first_away = "": second_home = "": second_away = "" 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, "dd.mm.yyyy 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 first_home = fs_row_parts(1) If fs_row_parts(0) = "BB" Then first_away = fs_row_parts(1) If fs_row_parts(0) = "BC" Then second_home = fs_row_parts(1) If fs_row_parts(0) = "BD" Then second_away = fs_row_parts(1) Next j If lig_indx = "1" Then GoTo 0 If lig_indx = "2" Then If country_name <> "Мир" And country_name <> "Европа" And InStr(tour_name, "Кубок") = 0 And country_name <> "World" And country_name <> "Europe" And InStr(tour_name, "Cup") = 0 Then
Опубликовано 14 марта, 20242 г. Только что, Lucky сказал: На сколько я понял в таком блоке их менять не нужно? ElseIf fs_index_name = "AA" Then first_home = "": first_away = "": second_home = "": second_away = "" 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, "dd.mm.yyyy 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 first_home = fs_row_parts(1) If fs_row_parts(0) = "BB" Then first_away = fs_row_parts(1) If fs_row_parts(0) = "BC" Then second_home = fs_row_parts(1) If fs_row_parts(0) = "BD" Then second_away = fs_row_parts(1) Next j If lig_indx = "1" Then GoTo 0 If lig_indx = "2" Then If country_name <> "Мир" And country_name <> "Европа" And InStr(tour_name, "Кубок") = 0 And country_name <> "World" And country_name <> "Europe" And InStr(tour_name, "Cup") = 0 Then
Опубликовано 14 марта, 20242 г. Постоянный 4 минуты назад, Lucky сказал: На сколько я понял в таком блоке их менять не нужно? ElseIf fs_index_name = "AA" Then first_home = "": first_away = "": second_home = "": second_away = "" 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, "dd.mm.yyyy 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 first_home = fs_row_parts(1) If fs_row_parts(0) = "BB" Then first_away = fs_row_parts(1) If fs_row_parts(0) = "BC" Then second_home = fs_row_parts(1) If fs_row_parts(0) = "BD" Then second_away = fs_row_parts(1) Next j If lig_indx = "1" Then GoTo 0 If lig_indx = "2" Then If country_name <> "Мир" And country_name <> "Европа" And InStr(tour_name, "Кубок") = 0 And country_name <> "World" And country_name <> "Europe" And InStr(tour_name, "Cup") = 0 Then я же написал, в блоках с AA ... BD, обязательно под замену индексы BA и BB, а также исправить расчёт результата
Опубликовано 14 марта, 20242 г. 7 минут назад, Shurik91 сказал: я же написал, в блоках с AA ... BD, обязательно под замену индексы BA и BB, а также исправить расчёт результата Я немного по ходу тупават в этой области, но вроде верно сделал? Sub getMatches() On Error Resume Next Application.Calculation = xlCalculationAutomatic Dim lr As Long Dim celPaste As Range Dim sourcer As String, suffix As String, match_id As String timezone = Sheets("Settings").Range("B1").Value - 1 dayzone = Sheets("Settings").Range("D1").Value - 8 sourcer = Sheets("Settings").Range("F1").Value lig_indx = Sheets("Settings").Range("K1").Value tours_indx = Sheets("Settings").Range("M1").Value If sourcer = 1 Then sourcer = "flashscore.com/" suffix = "_en_1_" ElseIf sourcer = 2 Then sourcer = "soccer24.com/" suffix = "_en_1_" ElseIf sourcer = 3 Then sourcer = "flashfootball.com/" suffix = "_en_1_" ElseIf sourcer = 4 Then sourcer = "flashscorekz.com/" suffix = "_en_1_" ElseIf sourcer = 5 Then sourcer = "livescore.in/ru/" suffix = "_ru_1" ElseIf sourcer = 6 Then sourcer = "livesport.com/ru/" suffix = "_ru_1" End If If Worksheets("listing").AutoFilterMode = True Then Worksheets("listing").Rows.AutoFilter Else End If x1 = ThisWorkbook.Sheets("Settings").Range("I1").Value If Sheets("DataPort").Range("j1").Value > 2 Then Sheets("DataPort").Range("j54").ClearContents Dim lRetVal As Long lRetVal = MsgBox("×òîáû Î÷èñòèòü ñóùåñòâóþùèé listing è íà÷àòü âñ¸ çàíîâî - íàæìèòå Äà." & _ Chr(10) & "×òîáû ïðîäîëæèòü listing äàëüøå - íàæìèòå Íåò." & _ Chr(10) & "×òîáû ïîäóìàòü, ÷òî æå ñäåëàòü - íàæìèòå Îòìåíà.", _ vbYesNoCancel + vbQuestion, "Î÷èñòèòü listing èëè... ?") If lRetVal = vbNo Then Sheets("DataPort").Range("j54").Value = 2 Else If lRetVal = vbYes Then Sheets("DataPort").Range("j54").Value = 1 Else If lRetVal = vbCancel Then Exit Sub End If End If End If Else End If If Sheets("DataPort").Range("j54").Value = 1 Then ClearLIST ClearPrevious Else End If a1 = Sheets("DataPort").Range("j1").Value b1 = 1 Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/f_1_" & dayzone & "_" & timezone & suffix, 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 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) = "ZY" Then country_name = fs_row_parts(1) If fs_row_parts(0) = "ZG" Then lig_type = fs_row_parts(1) '1 Òóðíèðû 2 Êóáîêè Next j ElseIf fs_index_name = "AA" Then first_home = "": first_away = "": second_home = "": second_away = "" 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, "dd.mm.yyyy 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) = "AT" Then first_home = fs_row_parts(1) If fs_row_parts(0) = "AU" Then first_away = fs_row_parts(1) If fs_row_parts(0) = "BC" Then second_home = fs_row_parts(1) If fs_row_parts(0) = "BD" Then second_away = fs_row_parts(1) Next j If lig_indx = "1" Then GoTo 0 If lig_indx = "2" Then If country_name <> "Ìèð" And country_name <> "Åâðîïà" And InStr(tour_name, "Êóáîê") = 0 And country_name <> "World" And country_name <> "Europe" And InStr(tour_name, "Cup") = 0 Then 0: Sheets("DataPort").Range("B51").Value = tour_name Sheets("DataPort").Range("B52").Value = date_match Sheets("DataPort").Range("B53").Value = home_name Sheets("DataPort").Range("B54").Value = away_name Sheets("DataPort").Range("B55").Value = match_id Else: GoTo nextpoint End If End If Application.Calculate ddd = Sheets("DataPort").Range("J55").Value If ddd > 0 Then GoTo 5: Else End If If first_home <> "" And second_home <> "" Then half_time = first_home & " : " & first_away full_time = (Val(first_home) + Val(second_home)) & " : " & (Val(first_away) + Val(second_away)) Sheets("DataPort").Range("B56").Value = half_time Sheets("DataPort").Range("B57").Value = full_time Else Sheets("DataPort").Range("B56").Value = "" Sheets("DataPort").Range("B57").Value = "" End If Call getOdds(sourcer, suffix, match_id) Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://www." & sourcer & "match/" & match_id & "/", False http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Pattern = "participantsData(.*?)home(.*?)id(.*?)sport_id(.*?)name(.*?)(.*?)image_path" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) participantEncodedIds1 = objMatches.Item(0).submatches(2) participantEncodedIds1 = Replace(participantEncodedIds1, Chr(34), "") participantEncodedIds1 = Replace(participantEncodedIds1, Chr(44), "") home_id1 = Replace(participantEncodedIds1, Chr(58), "") End If objRegExp.Pattern = "participantsData(.*?)away(.*?)id(.*?)sport_id(.*?)name(.*?)(.*?)image_path" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) participantEncodedIds2 = objMatches.Item(0).submatches(2) participantEncodedIds2 = Replace(participantEncodedIds2, Chr(34), "") participantEncodedIds2 = Replace(participantEncodedIds2, Chr(44), "") away_id1 = Replace(participantEncodedIds2, Chr(58), "") End If country_id = 0 objRegExp.Pattern = "initialDataLayer(.*?)stage(.*?)tournament(.*?)country" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) tournament_id1 = objMatches.Item(0).submatches(2) tournament_id1 = Replace(tournament_id1, Chr(34), "") tournament_id1 = Replace(tournament_id1, Chr(44), "") tournament_id1 = Replace(tournament_id1, Chr(58), "") tournament_id1 = Replace(tournament_id1, Chr(92), "") tournament_stage_id1 = objMatches.Item(0).submatches(1) tournament_stage_id1 = Replace(tournament_stage_id1, Chr(34), "") tournament_stage_id1 = Replace(tournament_stage_id1, Chr(44), "") tournament_stage_id1 = Replace(tournament_stage_id1, Chr(58), "") tournament_stage_id1 = Replace(tournament_stage_id1, Chr(92), "") Else objRegExp.Pattern = "initialDataLayer(.*?)stage(.*?)tournament(.*?)pushParameters" Set objMatches = objRegExp.Execute(fs_input) tournament_id1 = objMatches.Item(0).submatches(2) tournament_id1 = Replace(tournament_id1, Chr(34), "") tournament_id1 = Replace(tournament_id1, Chr(44), "") tournament_id1 = Replace(tournament_id1, Chr(58), "") tournament_id1 = Replace(tournament_id1, Chr(92), "") tournament_id1 = Replace(tournament_id1, Chr(125), "") tournament_stage_id1 = objMatches.Item(0).submatches(1) tournament_stage_id1 = Replace(tournament_stage_id1, Chr(34), "") tournament_stage_id1 = Replace(tournament_stage_id1, Chr(44), "") tournament_stage_id1 = Replace(tournament_stage_id1, Chr(58), "") tournament_stage_id1 = Replace(tournament_stage_id1, Chr(92), "") End If '**************************************************** Sheets("DataPort").Range("B58").Value = home_id1 Sheets("DataPort").Range("B59").Value = away_id1 Sheets("DataPort").Range("B60").Value = tournament_stage_id1 Sheets("DataPort").Range("B61").Value = tournament_id1 If Sheets("DataPort").Range("J60").Value = 1 Then GoTo 40: If Sheets("DataPort").Range("J60").Value = 0 Then GoTo 42: 42: ClearDataPort b1 = 2 Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id1 & "_" & tournament_stage_id1 & "_table_overall?hp1=" & home_id1 & "&hp2=" & away_id1 & "&e=" & match_id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = True 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 = ">(\d+)" & Chr(46) & "<(.*?)team_name(.*?)\;" & Chr(34) & ">(.*?)<(.*?)matches(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?):(.*?)<(.*?)>(.*?)>(.*?)<" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) For Each M In objMatches Sheets("DataPort").Range("a" & b1).Value = M.submatches(0) Sheets("DataPort").Range("b" & b1).Value = M.submatches(3) Sheets("DataPort").Range("c" & b1).Value = M.submatches(6) Sheets("DataPort").Range("d" & b1).Value = M.submatches(9) Sheets("DataPort").Range("e" & b1).Value = M.submatches(12) Sheets("DataPort").Range("f" & b1).Value = M.submatches(15) Sheets("DataPort").Range("g" & b1).Value = M.submatches(18) Sheets("DataPort").Range("h" & b1).Value = M.submatches(19) Sheets("DataPort").Range("i" & b1).Value = M.submatches(22) b1 = b1 + 1 If b1 > 46 Then GoTo 1 Next End If End If 1: b1 = 2 Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id1 & "_" & tournament_stage_id1 & "_table_home?hp1=" & home_id1 & "&hp2=" & away_id1 & "&e=" & match_id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = True 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 = ">(\d+)" & Chr(46) & "<(.*?)team_name(.*?)\;" & Chr(34) & ">(.*?)<(.*?)matches(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?):(.*?)<(.*?)>(.*?)>(.*?)<" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) For Each M In objMatches Sheets("DataPort").Range("k" & b1).Value = M.submatches(0) Sheets("DataPort").Range("l" & b1).Value = M.submatches(3) Sheets("DataPort").Range("m" & b1).Value = M.submatches(6) Sheets("DataPort").Range("n" & b1).Value = M.submatches(9) Sheets("DataPort").Range("o" & b1).Value = M.submatches(12) Sheets("DataPort").Range("p" & b1).Value = M.submatches(15) Sheets("DataPort").Range("q" & b1).Value = M.submatches(18) Sheets("DataPort").Range("r" & b1).Value = M.submatches(19) Sheets("DataPort").Range("s" & b1).Value = M.submatches(22) b1 = b1 + 1 If b1 > 46 Then GoTo 2 Next End If End If 2: b1 = 2 Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id1 & "_" & tournament_stage_id1 & "_form_overall?hp1=" & home_id1 & "&hp2=" & away_id1 & "&e=" & match_id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = True 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 = ">(\d+)" & Chr(46) & "<(.*?)team_name(.*?)\;" & Chr(34) & ">(.*?)<(.*?)matches(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?):(.*?)<(.*?)>(.*?)>(.*?)<" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) For Each M In objMatches Sheets("DataPort").Range("BD1").Value = M.submatches(6) f = M.submatches(6) If f = 5 Then Sheets("DataPort").Range("Bd" & b1).Value = M.submatches(0) Sheets("DataPort").Range("Be" & b1).Value = M.submatches(3) Sheets("DataPort").Range("Bf" & b1).Value = M.submatches(6) Sheets("DataPort").Range("BG" & b1).Value = M.submatches(9) Sheets("DataPort").Range("BH" & b1).Value = M.submatches(12) Sheets("DataPort").Range("BI" & b1).Value = M.submatches(15) Sheets("DataPort").Range("BJ" & b1).Value = M.submatches(18) Sheets("DataPort").Range("BK" & b1).Value = M.submatches(19) Sheets("DataPort").Range("BL" & b1).Value = M.submatches(22) b1 = b1 + 1 If b1 > 46 Then GoTo 3 Else: GoTo 10: End If 10: Next End If End If 3: b1 = 2 Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id1 & "_" & tournament_stage_id1 & "_over_under_overall?hp1=" & home_id1 & "&hp2=" & away_id1 & "&e=" & match_id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = True 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 = ">(\d+)" & Chr(46) & "<(.*?)team_name(.*?)\;" & Chr(34) & ">(.*?)<(.*?)matches(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?):(.*?)<(.*?)>(.*?)>(.*?)<" temper = "0" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) For Each M In objMatches If M.submatches(0) = 1 And temper = "2.5" Then temper = "3.5" If M.submatches(0) = 1 And temper = "1.5" Then temper = "2.5" If M.submatches(0) = 1 And temper = "0.5" Then temper = "1.5" If M.submatches(0) = 1 And temper = "0" Then temper = "0.5" If temper = "2.5" Then Sheets("DataPort").Range("AE" & b1).Value = temper Sheets("DataPort").Range("AF" & b1).Value = M.submatches(0) Sheets("DataPort").Range("AG" & b1).Value = M.submatches(3) Sheets("DataPort").Range("AH" & b1).Value = M.submatches(6) Sheets("DataPort").Range("AI" & b1).Value = M.submatches(9) Sheets("DataPort").Range("AJ" & b1).Value = M.submatches(12) Sheets("DataPort").Range("AK" & b1).Value = M.submatches(15) Sheets("DataPort").Range("AL" & b1).Value = M.submatches(16) b1 = b1 + 1 If b1 > 46 Then GoTo 4 Else: GoTo 20: End If 20: Next End If End If 4: b1 = 2 temper = "0" Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id1 & "_" & tournament_stage_id1 & "_over_under_home?hp1=" & home_id1 & "&hp2=" & away_id1 & "&e=" & match_id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = True 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 = ">(\d+)" & Chr(46) & "<(.*?)team_name(.*?)\;" & Chr(34) & ">(.*?)<(.*?)matches(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?):(.*?)<(.*?)>(.*?)>(.*?)<" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) For Each M In objMatches If M.submatches(0) = 1 And temper = "2.5" Then temper = "3.5" If M.submatches(0) = 1 And temper = "1.5" Then temper = "2.5" If M.submatches(0) = 1 And temper = "0.5" Then temper = "1.5" If M.submatches(0) = 1 And temper = "0" Then temper = "0.5" If temper = "2.5" Then Sheets("DataPort").Range("AM" & b1).Value = temper Sheets("DataPort").Range("AN" & b1).Value = M.submatches(0) Sheets("DataPort").Range("AO" & b1).Value = M.submatches(3) Sheets("DataPort").Range("AP" & b1).Value = M.submatches(6) Sheets("DataPort").Range("AQ" & b1).Value = M.submatches(9) Sheets("DataPort").Range("AR" & b1).Value = M.submatches(12) Sheets("DataPort").Range("AS" & b1).Value = M.submatches(15) Sheets("DataPort").Range("AT" & b1).Value = M.submatches(16) b1 = b1 + 1 If b1 > 46 Then GoTo 40 Else: GoTo 30: End If 30: Next End If End If 40: If tours_indx = 1 Then GoTo 50 If tours_indx = 2 Then On Error Resume Next If Sheets("V31V34").Range("R2").Value > 9 And Sheets("V31V34").Range("R3").Value > 9 Then 50: Sheets("listing").Range("A" & a1).Value = Sheets("DataPort").Range("B51").Value Sheets("listing").Range("B" & a1).Value = Sheets("DataPort").Range("B52").Value Sheets("listing").Range("C" & a1).Value = Sheets("DataPort").Range("B53").Value Sheets("listing").Range("D" & a1).Value = Sheets("DataPort").Range("B54").Value Sheets("listing").Range("E" & a1).Value = Sheets("DataPort").Range("B55").Value Sheets("listing").Range("F" & a1).Value = Sheets("V31V34").Range("A31").Value Sheets("listing").Range("G" & a1).Value = Sheets("V31V34").Range("B31").Value Sheets("listing").Range("H" & a1).Value = Sheets("V31V34").Range("C29").Value Sheets("listing").Range("I" & a1).Value = Sheets("V31V34").Range("D29").Value Sheets("listing").Range("J" & a1).Value = Sheets("V31V34").Range("E29").Value Sheets("listing").Range("K" & a1).Value = Sheets("V31V34").Range("P60").Value Sheets("listing").Range("L" & a1).Value = Sheets("V31V34").Range("Q60").Value Sheets("listing").Range("M" & a1).Value = Sheets("V31V34").Range("AB47").Value Sheets("listing").Range("N" & a1).Value = Sheets("V31V34").Range("AD47").Value Sheets("listing").Range("O" & a1).Value = Sheets("V31V34").Range("AP65").Value Sheets("listing").Range("P" & a1).Value = Sheets("V31V34").Range("AP66").Value Sheets("listing").Range("Q" & a1).Value = Sheets("V31V34").Range("W82").Value Sheets("listing").Range("R" & a1).Value = Sheets("V31V34").Range("W86").Value Sheets("listing").Range("S" & a1).Value = Sheets("V31V34").Range("E50").Value Sheets("listing").Range("T" & a1).Value = Sheets("V31V34").Range("F50").Value Sheets("listing").Range("U" & a1).Value = Sheets("V31V34").Range("G50").Value Sheets("listing").Range("V" & a1).Value = Sheets("V31V34").Range("E53").Value Sheets("listing").Range("W" & a1).Value = Sheets("V31V34").Range("I53").Value Sheets("listing").Range("X" & a1).Value = Sheets("V31V34").Range("CH11").Value Sheets("listing").Range("Y" & a1).Value = Sheets("V31V34").Range("CI11").Value Sheets("listing").Range("Z" & a1).Value = Sheets("V31V34").Range("CJ11").Value Sheets("listing").Range("AA" & a1).Value = Sheets("V31V34").Range("CI19").Value Sheets("listing").Range("AB" & a1).Value = Sheets("V31V34").Range("CH14").Value Sheets("listing").Range("AC" & a1).Value = Sheets("V31V34").Range("CJ14").Value Sheets("listing").Range("AD" & a1).Value = Sheets("V31V34").Range("CH17").Value Sheets("listing").Range("AE" & a1).Value = Sheets("V31V34").Range("CJ17").Value Sheets("listing").Range("AF" & a1).Value = Sheets("V31V34").Range("df1").Value Sheets("listing").Range("AG" & a1).Value = Sheets("V31V34").Range("S74").Value Sheets("listing").Range("AH" & a1).Value = Sheets("V31V34").Range("T74").Value Sheets("listing").Range("AI" & a1).Value = Sheets("V31V34").Range("U74").Value Sheets("listing").Range("AJ" & a1).Value = Sheets("V31V34").Range("S75").Value Sheets("listing").Range("AK" & a1).Value = Sheets("V31V34").Range("T75").Value Sheets("listing").Range("AL" & a1).Value = Sheets("V31V34").Range("U75").Value Sheets("listing").Range("AM" & a1).Value = Sheets("V31V34").Range("M29").Value Sheets("listing").Range("AN" & a1).Value = Sheets("V31V34").Range("N29").Value Sheets("listing").Range("AO" & a1).Value = Sheets("V31V34").Range("O29").Value Sheets("listing").Range("AP" & a1).Value = Sheets("V31V34").Range("P29").Value Sheets("listing").Range("AQ" & a1).Value = Sheets("V31V34").Range("B12").Value Sheets("listing").Range("AR" & a1).Value = Sheets("V31V34").Range("B13").Value Sheets("listing").Range("AS" & a1).Value = Sheets("V31V34").Range("B14").Value Sheets("listing").Range("AT" & a1).Value = Sheets("V31V34").Range("B16").Value Sheets("listing").Range("AU" & a1).Value = Sheets("V31V34").Range("B17").Value Sheets("listing").Range("AV" & a1).Value = Sheets("V31V34").Range("B18").Value Sheets("listing").Range("AW" & a1).Value = Sheets("V31V34").Range("B20").Value Sheets("listing").Range("AX" & a1).Value = Sheets("V31V34").Range("E14").Value Sheets("listing").Range("AY" & a1).Value = Sheets("V31V34").Range("F14").Value Sheets("listing").Range("AZ" & a1).Value = Sheets("V31V34").Range("E16").Value Sheets("listing").Range("BA" & a1).Value = Sheets("V31V34").Range("F16").Value Sheets("listing").Range("BB" & a1).Value = Sheets("V31V34").Range("U24").Value Sheets("listing").Range("BC" & a1).Value = Sheets("V31V34").Range("V24").Value Sheets("listing").Range("BD" & a1).Value = Sheets("V31V34").Range("E19").Value Sheets("listing").Range("BE" & a1).Value = Sheets("V31V34").Range("F19").Value Sheets("listing").Range("BF" & a1).Value = Sheets("V31V34").Range("E20").Value Sheets("listing").Range("BG" & a1).Value = Sheets("V31V34").Range("F20").Value Sheets("listing").Range("BH" & a1).Value = Sheets("V31V34").Range("BE79").Value Sheets("listing").Range("BI" & a1).Value = Sheets("DataPort").Range("B56").Value Sheets("listing").Range("BJ" & a1).Value = Sheets("DataPort").Range("B57").Value Sheets("listing").Range("BK" & a1).Value = Sheets("DataPort").Range("K51").Value Sheets("listing").Range("BL" & a1).Value = Sheets("DataPort").Range("L51").Value Sheets("listing").Range("BM" & a1).Value = Sheets("DataPort").Range("M51").Value Sheets("listing").Range("BN" & a1).Value = Sheets("DataPort").Range("N51").Value Sheets("listing").Range("BO" & a1).Value = Sheets("DataPort").Range("O51").Value Sheets("listing").Range("BP" & a1).Value = Sheets("DataPort").Range("P51").Value Sheets("listing").Range("BQ" & a1).Value = Sheets("DataPort").Range("Q51").Value Sheets("listing").Range("BR" & a1).Value = Sheets("DataPort").Range("R51").Value Sheets("listing").Range("BS" & a1).Value = Sheets("DataPort").Range("S51").Value Sheets("listing").Range("BT" & a1).Value = Sheets("DataPort").Range("T51").Value a1 = a1 + 1 End If On Error Resume Next ElseIf Sheets("V31V34").Range("R6").Value > 4 And Sheets("V31V34").Range("R7").Value > 4 Then GoTo 50 End If If x1 = 0 Then ThisWorkbook.save x1 = ThisWorkbook.Sheets("Settings").Range("I1").Value Else End If x1 = x1 - 1 End If Sheets("DataPort").Range("B51:B61").Copy Sheets("DataPort").Range("F51:F61") Sheets("DataPort").Range("B51:B61").ClearContents Sheets("DataPort").Range("K51:T61").ClearContents 5: Set celPaste = fncelPasteOnStatistic sbSelectRangeWithSheetVisible celPaste nextpoint: Next i If bShowBar Then Call MyProgresBar If bShowBar Then Unload frmStatusBar src = ThisWorkbook.Sheets("listing").Range("A" & Cells.Rows.Count).End(xlUp).Row ThisWorkbook.Sheets("listing").Range("A2:CA" & src).Sort Key1:=Sheets("listing").Columns("B"), Header:=xlYes, Order1:=xlAscending MsgBox "Çàãðóçêà çàâåðøåíà !" End Sub Sub getResults() On Error Resume Next lRetVal = MsgBox("Äàòó âûáðàëè?", vbYesNo + vbQuestion, "Ïðîâåðüòå äàòó...") If lRetVal = vbNo Then Exit Sub End If If Worksheets("listing").AutoFilterMode = True Then Worksheets("listing").Rows.AutoFilter Else End If timezone = ThisWorkbook.Sheets("Settings").Range("B1").Value - 1 dayzone = ThisWorkbook.Sheets("Settings").Range("D1").Value - 8 sourcer = ThisWorkbook.Sheets("Settings").Range("F1").Value If sourcer = 1 Then sourcer = "flashscore.com/" suffix = "_en_1_" ElseIf sourcer = 2 Then sourcer = "soccer24.com/" suffix = "_en_1_" ElseIf sourcer = 3 Then sourcer = "flashfootball.com/" suffix = "_en_1_" ElseIf sourcer = 4 Then sourcer = "flashscorekz.com/" suffix = "_en_1_" ElseIf sourcer = 5 Then sourcer = "livescore.in/ru/" suffix = "_ru_1" ElseIf sourcer = 6 Then sourcer = "livesport.com/ru/" suffix = "_ru_1" End If Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/f_1_" & dayzone & "_" & timezone & suffix, 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) For i = 0 To fs_rows_length - 4 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 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 first_home = "": first_away = "": second_home = "": second_away = "" 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) = "AT" Then first_home = fs_row_parts(1) If fs_row_parts(0) = "AU" Then first_away = fs_row_parts(1) If fs_row_parts(0) = "BC" Then second_home = fs_row_parts(1) If fs_row_parts(0) = "BD" Then second_away = fs_row_parts(1) If fs_row_parts(0) = "AB" Then status_game = fs_row_parts(1) If fs_row_parts(0) = "AC" Then status_game_code = fs_row_parts(1) Next j Set fcell = ThisWorkbook.Sheets("listing").Columns("E:E").Find(match_id) rowindx = CStr(fcell.Row) If status_game = 3 And (status_game_code = 3 Or status_game_code = 10 Or status_game_code = 11) And first_home <> "" And second_home <> "" Then Sheets("listing").Range("BI" & rowindx).Value = Val(first_home) - Val(second_home) & " : " & Val(first_away) - Val(second_away) Sheets("listing").Range("BJ" & rowindx).Value = first_home & " : " & first_away End If End If rowindx = 0 Next i MsgBox "Ðåçóëüòàòû îáíîâëåíû !" End Sub Sub UpdateOdds() Dim sourcer As String, suffix As String, match_id As String, rwindx As String timezone = Sheets("Settings").Range("B1").Value - 1 dayzone = Sheets("Settings").Range("D1").Value - 8 sourcer = Sheets("Settings").Range("F1").Value If sourcer = 1 Then sourcer = "flashscore.com/" suffix = "_en_1_" ElseIf sourcer = 2 Then sourcer = "soccer24.com/" suffix = "_en_1_" ElseIf sourcer = 3 Then sourcer = "flashfootball.com/" suffix = "_en_1_" ElseIf sourcer = 4 Then sourcer = "flashscorekz.com/" suffix = "_en_1_" ElseIf sourcer = 5 Then sourcer = "livescore.in/ru/" suffix = "_ru_1" ElseIf sourcer = 6 Then sourcer = "livesport.com/ru/" suffix = "_ru_1" End If cnt = ThisWorkbook.Sheets("listing").Range("E" & Cells.Rows.Count).End(xlUp).Row For i = 2 To cnt rwindx = i match_id = ThisWorkbook.Sheets("listing").Range("E" & i).Value Call getOdds2(sourcer, suffix, match_id, rwindx) Next i MsgBox "Êîýôôèöèåíòû îáíîâëåíû !" End Sub Sub toArchive() ThisWorkbook.Sheets("archive").Activate End Sub Sub ClearPrevious() Sheets("DataPort").Range("a2:s46").ClearContents Sheets("DataPort").Range("ae2:at46").ClearContents Sheets("DataPort").Range("bd2:bl46").ClearContents Sheets("DataPort").Range("k51:t51").ClearContents Sheets("DataPort").Range("b51:f61").ClearContents End Sub Sub ClearDataPort() Sheets("DataPort").Range("a2:s46").ClearContents Sheets("DataPort").Range("ae2:at46").ClearContents Sheets("DataPort").Range("bd2:bl46").ClearContents End Sub Function fncelPasteOnStatistic() As Range With Sheets("listing") Set fncelPasteOnStatistic = .Cells(.Rows.Count, "A").End(xlUp).Offset(1) End With End Function Sub sbSelectRangeWithSheetVisible(rng As Range) Dim ws As Worksheet Set ws = rng.Parent ws.Visible = xlSheetVisible ws.Activate rng.Select End Sub Sub ClearLIST() Dim lastRow As Long: lastRow = Range("listing!A3").End(xlDown).Row 'change to whatever column you have Dim i As Long Sheets("listing").Activate Range(Cells(3, 1), Cells(lastRow, 80)).ClearContents End Sub Проверьте пожалуйста домашку 🙂 !!!
Опубликовано 14 марта, 20242 г. Постоянный вот здесь, нужно расчёты изменить: Было так: If first_home <> "" And second_home <> "" Then half_time = first_home & " : " & first_away full_time = (Val(first_home) + Val(second_home)) & " : " & (Val(first_away) + Val(second_away)) Sheets("DataPort").Range("B56").Value = half_time Sheets("DataPort").Range("B57").Value = full_time Должно быть так: If first_home <> "" And second_home <> "" Then half_time = Val(first_home) - Val(second_home)) & " : " & (Val(first_away) - Val(second_away) full_time = first_home & " : " & first_away Sheets("DataPort").Range("B56").Value = half_time Sheets("DataPort").Range("B57").Value = full_time 😉
Опубликовано 14 марта, 20242 г. 8 минут назад, Lucky сказал: Я немного по ходу тупават в этой области, но вроде верно сделал? Sub getMatches() On Error Resume Next Application.Calculation = xlCalculationAutomatic Dim lr As Long Dim celPaste As Range Dim sourcer As String, suffix As String, match_id As String timezone = Sheets("Settings").Range("B1").Value - 1 dayzone = Sheets("Settings").Range("D1").Value - 8 sourcer = Sheets("Settings").Range("F1").Value lig_indx = Sheets("Settings").Range("K1").Value tours_indx = Sheets("Settings").Range("M1").Value If sourcer = 1 Then sourcer = "flashscore.com/" suffix = "_en_1_" ElseIf sourcer = 2 Then sourcer = "soccer24.com/" suffix = "_en_1_" ElseIf sourcer = 3 Then sourcer = "flashfootball.com/" suffix = "_en_1_" ElseIf sourcer = 4 Then sourcer = "flashscorekz.com/" suffix = "_en_1_" ElseIf sourcer = 5 Then sourcer = "livescore.in/ru/" suffix = "_ru_1" ElseIf sourcer = 6 Then sourcer = "livesport.com/ru/" suffix = "_ru_1" End If If Worksheets("listing").AutoFilterMode = True Then Worksheets("listing").Rows.AutoFilter Else End If x1 = ThisWorkbook.Sheets("Settings").Range("I1").Value If Sheets("DataPort").Range("j1").Value > 2 Then Sheets("DataPort").Range("j54").ClearContents Dim lRetVal As Long lRetVal = MsgBox("×òîáû Î÷èñòèòü ñóùåñòâóþùèé listing è íà÷àòü âñ¸ çàíîâî - íàæìèòå Äà." & _ Chr(10) & "×òîáû ïðîäîëæèòü listing äàëüøå - íàæìèòå Íåò." & _ Chr(10) & "×òîáû ïîäóìàòü, ÷òî æå ñäåëàòü - íàæìèòå Îòìåíà.", _ vbYesNoCancel + vbQuestion, "Î÷èñòèòü listing èëè... ?") If lRetVal = vbNo Then Sheets("DataPort").Range("j54").Value = 2 Else If lRetVal = vbYes Then Sheets("DataPort").Range("j54").Value = 1 Else If lRetVal = vbCancel Then Exit Sub End If End If End If Else End If If Sheets("DataPort").Range("j54").Value = 1 Then ClearLIST ClearPrevious Else End If a1 = Sheets("DataPort").Range("j1").Value b1 = 1 Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/f_1_" & dayzone & "_" & timezone & suffix, 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 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) = "ZY" Then country_name = fs_row_parts(1) If fs_row_parts(0) = "ZG" Then lig_type = fs_row_parts(1) '1 Òóðíèðû 2 Êóáîêè Next j ElseIf fs_index_name = "AA" Then first_home = "": first_away = "": second_home = "": second_away = "" 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, "dd.mm.yyyy 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) = "AT" Then first_home = fs_row_parts(1) If fs_row_parts(0) = "AU" Then first_away = fs_row_parts(1) If fs_row_parts(0) = "BC" Then second_home = fs_row_parts(1) If fs_row_parts(0) = "BD" Then second_away = fs_row_parts(1) Next j If lig_indx = "1" Then GoTo 0 If lig_indx = "2" Then If country_name <> "Ìèð" And country_name <> "Åâðîïà" And InStr(tour_name, "Êóáîê") = 0 And country_name <> "World" And country_name <> "Europe" And InStr(tour_name, "Cup") = 0 Then 0: Sheets("DataPort").Range("B51").Value = tour_name Sheets("DataPort").Range("B52").Value = date_match Sheets("DataPort").Range("B53").Value = home_name Sheets("DataPort").Range("B54").Value = away_name Sheets("DataPort").Range("B55").Value = match_id Else: GoTo nextpoint End If End If Application.Calculate ddd = Sheets("DataPort").Range("J55").Value If ddd > 0 Then GoTo 5: Else End If If first_home <> "" And second_home <> "" Then half_time = first_home & " : " & first_away full_time = (Val(first_home) + Val(second_home)) & " : " & (Val(first_away) + Val(second_away)) Sheets("DataPort").Range("B56").Value = half_time Sheets("DataPort").Range("B57").Value = full_time Else Sheets("DataPort").Range("B56").Value = "" Sheets("DataPort").Range("B57").Value = "" End If Call getOdds(sourcer, suffix, match_id) Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://www." & sourcer & "match/" & match_id & "/", False http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Pattern = "participantsData(.*?)home(.*?)id(.*?)sport_id(.*?)name(.*?)(.*?)image_path" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) participantEncodedIds1 = objMatches.Item(0).submatches(2) participantEncodedIds1 = Replace(participantEncodedIds1, Chr(34), "") participantEncodedIds1 = Replace(participantEncodedIds1, Chr(44), "") home_id1 = Replace(participantEncodedIds1, Chr(58), "") End If objRegExp.Pattern = "participantsData(.*?)away(.*?)id(.*?)sport_id(.*?)name(.*?)(.*?)image_path" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) participantEncodedIds2 = objMatches.Item(0).submatches(2) participantEncodedIds2 = Replace(participantEncodedIds2, Chr(34), "") participantEncodedIds2 = Replace(participantEncodedIds2, Chr(44), "") away_id1 = Replace(participantEncodedIds2, Chr(58), "") End If country_id = 0 objRegExp.Pattern = "initialDataLayer(.*?)stage(.*?)tournament(.*?)country" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) tournament_id1 = objMatches.Item(0).submatches(2) tournament_id1 = Replace(tournament_id1, Chr(34), "") tournament_id1 = Replace(tournament_id1, Chr(44), "") tournament_id1 = Replace(tournament_id1, Chr(58), "") tournament_id1 = Replace(tournament_id1, Chr(92), "") tournament_stage_id1 = objMatches.Item(0).submatches(1) tournament_stage_id1 = Replace(tournament_stage_id1, Chr(34), "") tournament_stage_id1 = Replace(tournament_stage_id1, Chr(44), "") tournament_stage_id1 = Replace(tournament_stage_id1, Chr(58), "") tournament_stage_id1 = Replace(tournament_stage_id1, Chr(92), "") Else objRegExp.Pattern = "initialDataLayer(.*?)stage(.*?)tournament(.*?)pushParameters" Set objMatches = objRegExp.Execute(fs_input) tournament_id1 = objMatches.Item(0).submatches(2) tournament_id1 = Replace(tournament_id1, Chr(34), "") tournament_id1 = Replace(tournament_id1, Chr(44), "") tournament_id1 = Replace(tournament_id1, Chr(58), "") tournament_id1 = Replace(tournament_id1, Chr(92), "") tournament_id1 = Replace(tournament_id1, Chr(125), "") tournament_stage_id1 = objMatches.Item(0).submatches(1) tournament_stage_id1 = Replace(tournament_stage_id1, Chr(34), "") tournament_stage_id1 = Replace(tournament_stage_id1, Chr(44), "") tournament_stage_id1 = Replace(tournament_stage_id1, Chr(58), "") tournament_stage_id1 = Replace(tournament_stage_id1, Chr(92), "") End If '**************************************************** Sheets("DataPort").Range("B58").Value = home_id1 Sheets("DataPort").Range("B59").Value = away_id1 Sheets("DataPort").Range("B60").Value = tournament_stage_id1 Sheets("DataPort").Range("B61").Value = tournament_id1 If Sheets("DataPort").Range("J60").Value = 1 Then GoTo 40: If Sheets("DataPort").Range("J60").Value = 0 Then GoTo 42: 42: ClearDataPort b1 = 2 Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id1 & "_" & tournament_stage_id1 & "_table_overall?hp1=" & home_id1 & "&hp2=" & away_id1 & "&e=" & match_id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = True 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 = ">(\d+)" & Chr(46) & "<(.*?)team_name(.*?)\;" & Chr(34) & ">(.*?)<(.*?)matches(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?):(.*?)<(.*?)>(.*?)>(.*?)<" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) For Each M In objMatches Sheets("DataPort").Range("a" & b1).Value = M.submatches(0) Sheets("DataPort").Range("b" & b1).Value = M.submatches(3) Sheets("DataPort").Range("c" & b1).Value = M.submatches(6) Sheets("DataPort").Range("d" & b1).Value = M.submatches(9) Sheets("DataPort").Range("e" & b1).Value = M.submatches(12) Sheets("DataPort").Range("f" & b1).Value = M.submatches(15) Sheets("DataPort").Range("g" & b1).Value = M.submatches(18) Sheets("DataPort").Range("h" & b1).Value = M.submatches(19) Sheets("DataPort").Range("i" & b1).Value = M.submatches(22) b1 = b1 + 1 If b1 > 46 Then GoTo 1 Next End If End If 1: b1 = 2 Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id1 & "_" & tournament_stage_id1 & "_table_home?hp1=" & home_id1 & "&hp2=" & away_id1 & "&e=" & match_id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = True 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 = ">(\d+)" & Chr(46) & "<(.*?)team_name(.*?)\;" & Chr(34) & ">(.*?)<(.*?)matches(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?):(.*?)<(.*?)>(.*?)>(.*?)<" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) For Each M In objMatches Sheets("DataPort").Range("k" & b1).Value = M.submatches(0) Sheets("DataPort").Range("l" & b1).Value = M.submatches(3) Sheets("DataPort").Range("m" & b1).Value = M.submatches(6) Sheets("DataPort").Range("n" & b1).Value = M.submatches(9) Sheets("DataPort").Range("o" & b1).Value = M.submatches(12) Sheets("DataPort").Range("p" & b1).Value = M.submatches(15) Sheets("DataPort").Range("q" & b1).Value = M.submatches(18) Sheets("DataPort").Range("r" & b1).Value = M.submatches(19) Sheets("DataPort").Range("s" & b1).Value = M.submatches(22) b1 = b1 + 1 If b1 > 46 Then GoTo 2 Next End If End If 2: b1 = 2 Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id1 & "_" & tournament_stage_id1 & "_form_overall?hp1=" & home_id1 & "&hp2=" & away_id1 & "&e=" & match_id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = True 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 = ">(\d+)" & Chr(46) & "<(.*?)team_name(.*?)\;" & Chr(34) & ">(.*?)<(.*?)matches(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?):(.*?)<(.*?)>(.*?)>(.*?)<" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) For Each M In objMatches Sheets("DataPort").Range("BD1").Value = M.submatches(6) f = M.submatches(6) If f = 5 Then Sheets("DataPort").Range("Bd" & b1).Value = M.submatches(0) Sheets("DataPort").Range("Be" & b1).Value = M.submatches(3) Sheets("DataPort").Range("Bf" & b1).Value = M.submatches(6) Sheets("DataPort").Range("BG" & b1).Value = M.submatches(9) Sheets("DataPort").Range("BH" & b1).Value = M.submatches(12) Sheets("DataPort").Range("BI" & b1).Value = M.submatches(15) Sheets("DataPort").Range("BJ" & b1).Value = M.submatches(18) Sheets("DataPort").Range("BK" & b1).Value = M.submatches(19) Sheets("DataPort").Range("BL" & b1).Value = M.submatches(22) b1 = b1 + 1 If b1 > 46 Then GoTo 3 Else: GoTo 10: End If 10: Next End If End If 3: b1 = 2 Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id1 & "_" & tournament_stage_id1 & "_over_under_overall?hp1=" & home_id1 & "&hp2=" & away_id1 & "&e=" & match_id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = True 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 = ">(\d+)" & Chr(46) & "<(.*?)team_name(.*?)\;" & Chr(34) & ">(.*?)<(.*?)matches(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?):(.*?)<(.*?)>(.*?)>(.*?)<" temper = "0" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) For Each M In objMatches If M.submatches(0) = 1 And temper = "2.5" Then temper = "3.5" If M.submatches(0) = 1 And temper = "1.5" Then temper = "2.5" If M.submatches(0) = 1 And temper = "0.5" Then temper = "1.5" If M.submatches(0) = 1 And temper = "0" Then temper = "0.5" If temper = "2.5" Then Sheets("DataPort").Range("AE" & b1).Value = temper Sheets("DataPort").Range("AF" & b1).Value = M.submatches(0) Sheets("DataPort").Range("AG" & b1).Value = M.submatches(3) Sheets("DataPort").Range("AH" & b1).Value = M.submatches(6) Sheets("DataPort").Range("AI" & b1).Value = M.submatches(9) Sheets("DataPort").Range("AJ" & b1).Value = M.submatches(12) Sheets("DataPort").Range("AK" & b1).Value = M.submatches(15) Sheets("DataPort").Range("AL" & b1).Value = M.submatches(16) b1 = b1 + 1 If b1 > 46 Then GoTo 4 Else: GoTo 20: End If 20: Next End If End If 4: b1 = 2 temper = "0" Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id1 & "_" & tournament_stage_id1 & "_over_under_home?hp1=" & home_id1 & "&hp2=" & away_id1 & "&e=" & match_id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = True 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 = ">(\d+)" & Chr(46) & "<(.*?)team_name(.*?)\;" & Chr(34) & ">(.*?)<(.*?)matches(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?)<(.*?)>(.*?)>(.*?):(.*?)<(.*?)>(.*?)>(.*?)<" If objRegExp.Test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) For Each M In objMatches If M.submatches(0) = 1 And temper = "2.5" Then temper = "3.5" If M.submatches(0) = 1 And temper = "1.5" Then temper = "2.5" If M.submatches(0) = 1 And temper = "0.5" Then temper = "1.5" If M.submatches(0) = 1 And temper = "0" Then temper = "0.5" If temper = "2.5" Then Sheets("DataPort").Range("AM" & b1).Value = temper Sheets("DataPort").Range("AN" & b1).Value = M.submatches(0) Sheets("DataPort").Range("AO" & b1).Value = M.submatches(3) Sheets("DataPort").Range("AP" & b1).Value = M.submatches(6) Sheets("DataPort").Range("AQ" & b1).Value = M.submatches(9) Sheets("DataPort").Range("AR" & b1).Value = M.submatches(12) Sheets("DataPort").Range("AS" & b1).Value = M.submatches(15) Sheets("DataPort").Range("AT" & b1).Value = M.submatches(16) b1 = b1 + 1 If b1 > 46 Then GoTo 40 Else: GoTo 30: End If 30: Next End If End If 40: If tours_indx = 1 Then GoTo 50 If tours_indx = 2 Then On Error Resume Next If Sheets("V31V34").Range("R2").Value > 9 And Sheets("V31V34").Range("R3").Value > 9 Then 50: Sheets("listing").Range("A" & a1).Value = Sheets("DataPort").Range("B51").Value Sheets("listing").Range("B" & a1).Value = Sheets("DataPort").Range("B52").Value Sheets("listing").Range("C" & a1).Value = Sheets("DataPort").Range("B53").Value Sheets("listing").Range("D" & a1).Value = Sheets("DataPort").Range("B54").Value Sheets("listing").Range("E" & a1).Value = Sheets("DataPort").Range("B55").Value Sheets("listing").Range("F" & a1).Value = Sheets("V31V34").Range("A31").Value Sheets("listing").Range("G" & a1).Value = Sheets("V31V34").Range("B31").Value Sheets("listing").Range("H" & a1).Value = Sheets("V31V34").Range("C29").Value Sheets("listing").Range("I" & a1).Value = Sheets("V31V34").Range("D29").Value Sheets("listing").Range("J" & a1).Value = Sheets("V31V34").Range("E29").Value Sheets("listing").Range("K" & a1).Value = Sheets("V31V34").Range("P60").Value Sheets("listing").Range("L" & a1).Value = Sheets("V31V34").Range("Q60").Value Sheets("listing").Range("M" & a1).Value = Sheets("V31V34").Range("AB47").Value Sheets("listing").Range("N" & a1).Value = Sheets("V31V34").Range("AD47").Value Sheets("listing").Range("O" & a1).Value = Sheets("V31V34").Range("AP65").Value Sheets("listing").Range("P" & a1).Value = Sheets("V31V34").Range("AP66").Value Sheets("listing").Range("Q" & a1).Value = Sheets("V31V34").Range("W82").Value Sheets("listing").Range("R" & a1).Value = Sheets("V31V34").Range("W86").Value Sheets("listing").Range("S" & a1).Value = Sheets("V31V34").Range("E50").Value Sheets("listing").Range("T" & a1).Value = Sheets("V31V34").Range("F50").Value Sheets("listing").Range("U" & a1).Value = Sheets("V31V34").Range("G50").Value Sheets("listing").Range("V" & a1).Value = Sheets("V31V34").Range("E53").Value Sheets("listing").Range("W" & a1).Value = Sheets("V31V34").Range("I53").Value Sheets("listing").Range("X" & a1).Value = Sheets("V31V34").Range("CH11").Value Sheets("listing").Range("Y" & a1).Value = Sheets("V31V34").Range("CI11").Value Sheets("listing").Range("Z" & a1).Value = Sheets("V31V34").Range("CJ11").Value Sheets("listing").Range("AA" & a1).Value = Sheets("V31V34").Range("CI19").Value Sheets("listing").Range("AB" & a1).Value = Sheets("V31V34").Range("CH14").Value Sheets("listing").Range("AC" & a1).Value = Sheets("V31V34").Range("CJ14").Value Sheets("listing").Range("AD" & a1).Value = Sheets("V31V34").Range("CH17").Value Sheets("listing").Range("AE" & a1).Value = Sheets("V31V34").Range("CJ17").Value Sheets("listing").Range("AF" & a1).Value = Sheets("V31V34").Range("df1").Value Sheets("listing").Range("AG" & a1).Value = Sheets("V31V34").Range("S74").Value Sheets("listing").Range("AH" & a1).Value = Sheets("V31V34").Range("T74").Value Sheets("listing").Range("AI" & a1).Value = Sheets("V31V34").Range("U74").Value Sheets("listing").Range("AJ" & a1).Value = Sheets("V31V34").Range("S75").Value Sheets("listing").Range("AK" & a1).Value = Sheets("V31V34").Range("T75").Value Sheets("listing").Range("AL" & a1).Value = Sheets("V31V34").Range("U75").Value Sheets("listing").Range("AM" & a1).Value = Sheets("V31V34").Range("M29").Value Sheets("listing").Range("AN" & a1).Value = Sheets("V31V34").Range("N29").Value Sheets("listing").Range("AO" & a1).Value = Sheets("V31V34").Range("O29").Value Sheets("listing").Range("AP" & a1).Value = Sheets("V31V34").Range("P29").Value Sheets("listing").Range("AQ" & a1).Value = Sheets("V31V34").Range("B12").Value Sheets("listing").Range("AR" & a1).Value = Sheets("V31V34").Range("B13").Value Sheets("listing").Range("AS" & a1).Value = Sheets("V31V34").Range("B14").Value Sheets("listing").Range("AT" & a1).Value = Sheets("V31V34").Range("B16").Value Sheets("listing").Range("AU" & a1).Value = Sheets("V31V34").Range("B17").Value Sheets("listing").Range("AV" & a1).Value = Sheets("V31V34").Range("B18").Value Sheets("listing").Range("AW" & a1).Value = Sheets("V31V34").Range("B20").Value Sheets("listing").Range("AX" & a1).Value = Sheets("V31V34").Range("E14").Value Sheets("listing").Range("AY" & a1).Value = Sheets("V31V34").Range("F14").Value Sheets("listing").Range("AZ" & a1).Value = Sheets("V31V34").Range("E16").Value Sheets("listing").Range("BA" & a1).Value = Sheets("V31V34").Range("F16").Value Sheets("listing").Range("BB" & a1).Value = Sheets("V31V34").Range("U24").Value Sheets("listing").Range("BC" & a1).Value = Sheets("V31V34").Range("V24").Value Sheets("listing").Range("BD" & a1).Value = Sheets("V31V34").Range("E19").Value Sheets("listing").Range("BE" & a1).Value = Sheets("V31V34").Range("F19").Value Sheets("listing").Range("BF" & a1).Value = Sheets("V31V34").Range("E20").Value Sheets("listing").Range("BG" & a1).Value = Sheets("V31V34").Range("F20").Value Sheets("listing").Range("BH" & a1).Value = Sheets("V31V34").Range("BE79").Value Sheets("listing").Range("BI" & a1).Value = Sheets("DataPort").Range("B56").Value Sheets("listing").Range("BJ" & a1).Value = Sheets("DataPort").Range("B57").Value Sheets("listing").Range("BK" & a1).Value = Sheets("DataPort").Range("K51").Value Sheets("listing").Range("BL" & a1).Value = Sheets("DataPort").Range("L51").Value Sheets("listing").Range("BM" & a1).Value = Sheets("DataPort").Range("M51").Value Sheets("listing").Range("BN" & a1).Value = Sheets("DataPort").Range("N51").Value Sheets("listing").Range("BO" & a1).Value = Sheets("DataPort").Range("O51").Value Sheets("listing").Range("BP" & a1).Value = Sheets("DataPort").Range("P51").Value Sheets("listing").Range("BQ" & a1).Value = Sheets("DataPort").Range("Q51").Value Sheets("listing").Range("BR" & a1).Value = Sheets("DataPort").Range("R51").Value Sheets("listing").Range("BS" & a1).Value = Sheets("DataPort").Range("S51").Value Sheets("listing").Range("BT" & a1).Value = Sheets("DataPort").Range("T51").Value a1 = a1 + 1 End If On Error Resume Next ElseIf Sheets("V31V34").Range("R6").Value > 4 And Sheets("V31V34").Range("R7").Value > 4 Then GoTo 50 End If If x1 = 0 Then ThisWorkbook.save x1 = ThisWorkbook.Sheets("Settings").Range("I1").Value Else End If x1 = x1 - 1 End If Sheets("DataPort").Range("B51:B61").Copy Sheets("DataPort").Range("F51:F61") Sheets("DataPort").Range("B51:B61").ClearContents Sheets("DataPort").Range("K51:T61").ClearContents 5: Set celPaste = fncelPasteOnStatistic sbSelectRangeWithSheetVisible celPaste nextpoint: Next i If bShowBar Then Call MyProgresBar If bShowBar Then Unload frmStatusBar src = ThisWorkbook.Sheets("listing").Range("A" & Cells.Rows.Count).End(xlUp).Row ThisWorkbook.Sheets("listing").Range("A2:CA" & src).Sort Key1:=Sheets("listing").Columns("B"), Header:=xlYes, Order1:=xlAscending MsgBox "Çàãðóçêà çàâåðøåíà !" End Sub Sub getResults() On Error Resume Next lRetVal = MsgBox("Äàòó âûáðàëè?", vbYesNo + vbQuestion, "Ïðîâåðüòå äàòó...") If lRetVal = vbNo Then Exit Sub End If If Worksheets("listing").AutoFilterMode = True Then Worksheets("listing").Rows.AutoFilter Else End If timezone = ThisWorkbook.Sheets("Settings").Range("B1").Value - 1 dayzone = ThisWorkbook.Sheets("Settings").Range("D1").Value - 8 sourcer = ThisWorkbook.Sheets("Settings").Range("F1").Value If sourcer = 1 Then sourcer = "flashscore.com/" suffix = "_en_1_" ElseIf sourcer = 2 Then sourcer = "soccer24.com/" suffix = "_en_1_" ElseIf sourcer = 3 Then sourcer = "flashfootball.com/" suffix = "_en_1_" ElseIf sourcer = 4 Then sourcer = "flashscorekz.com/" suffix = "_en_1_" ElseIf sourcer = 5 Then sourcer = "livescore.in/ru/" suffix = "_ru_1" ElseIf sourcer = 6 Then sourcer = "livesport.com/ru/" suffix = "_ru_1" End If Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/f_1_" & dayzone & "_" & timezone & suffix, 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) For i = 0 To fs_rows_length - 4 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 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 first_home = "": first_away = "": second_home = "": second_away = "" 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) = "AT" Then first_home = fs_row_parts(1) If fs_row_parts(0) = "AU" Then first_away = fs_row_parts(1) If fs_row_parts(0) = "BC" Then second_home = fs_row_parts(1) If fs_row_parts(0) = "BD" Then second_away = fs_row_parts(1) If fs_row_parts(0) = "AB" Then status_game = fs_row_parts(1) If fs_row_parts(0) = "AC" Then status_game_code = fs_row_parts(1) Next j Set fcell = ThisWorkbook.Sheets("listing").Columns("E:E").Find(match_id) rowindx = CStr(fcell.Row) If status_game = 3 And (status_game_code = 3 Or status_game_code = 10 Or status_game_code = 11) And first_home <> "" And second_home <> "" Then Sheets("listing").Range("BI" & rowindx).Value = Val(first_home) - Val(second_home) & " : " & Val(first_away) - Val(second_away) Sheets("listing").Range("BJ" & rowindx).Value = first_home & " : " & first_away End If End If rowindx = 0 Next i MsgBox "Ðåçóëüòàòû îáíîâëåíû !" End Sub Sub UpdateOdds() Dim sourcer As String, suffix As String, match_id As String, rwindx As String timezone = Sheets("Settings").Range("B1").Value - 1 dayzone = Sheets("Settings").Range("D1").Value - 8 sourcer = Sheets("Settings").Range("F1").Value If sourcer = 1 Then sourcer = "flashscore.com/" suffix = "_en_1_" ElseIf sourcer = 2 Then sourcer = "soccer24.com/" suffix = "_en_1_" ElseIf sourcer = 3 Then sourcer = "flashfootball.com/" suffix = "_en_1_" ElseIf sourcer = 4 Then sourcer = "flashscorekz.com/" suffix = "_en_1_" ElseIf sourcer = 5 Then sourcer = "livescore.in/ru/" suffix = "_ru_1" ElseIf sourcer = 6 Then sourcer = "livesport.com/ru/" suffix = "_ru_1" End If cnt = ThisWorkbook.Sheets("listing").Range("E" & Cells.Rows.Count).End(xlUp).Row For i = 2 To cnt rwindx = i match_id = ThisWorkbook.Sheets("listing").Range("E" & i).Value Call getOdds2(sourcer, suffix, match_id, rwindx) Next i MsgBox "Êîýôôèöèåíòû îáíîâëåíû !" End Sub Sub toArchive() ThisWorkbook.Sheets("archive").Activate End Sub Sub ClearPrevious() Sheets("DataPort").Range("a2:s46").ClearContents Sheets("DataPort").Range("ae2:at46").ClearContents Sheets("DataPort").Range("bd2:bl46").ClearContents Sheets("DataPort").Range("k51:t51").ClearContents Sheets("DataPort").Range("b51:f61").ClearContents End Sub Sub ClearDataPort() Sheets("DataPort").Range("a2:s46").ClearContents Sheets("DataPort").Range("ae2:at46").ClearContents Sheets("DataPort").Range("bd2:bl46").ClearContents End Sub Function fncelPasteOnStatistic() As Range With Sheets("listing") Set fncelPasteOnStatistic = .Cells(.Rows.Count, "A").End(xlUp).Offset(1) End With End Function Sub sbSelectRangeWithSheetVisible(rng As Range) Dim ws As Worksheet Set ws = rng.Parent ws.Visible = xlSheetVisible ws.Activate rng.Select End Sub Sub ClearLIST() Dim lastRow As Long: lastRow = Range("listing!A3").End(xlDown).Row 'change to whatever column you have Dim i As Long Sheets("listing").Activate Range(Cells(3, 1), Cells(lastRow, 80)).ClearContents End Sub Проверьте пожалуйста домашку 🙂 !!! Просто есть сейчас такая вероятность, что вся стата пойдет на перекосяк!
Опубликовано 14 марта, 20242 г. 1 минуту назад, Lucky сказал: Просто есть сейчас такая вероятность, что вся стата пойдет на перекосяк! Соответственно и все рассчеты!
Опубликовано 14 марта, 20242 г. 2 минуты назад, Lucky сказал: Соответственно и все рассчеты! И ребята может по какому рублю скинем человеку так как он сейчас все эту муть с сайтом разгребает если он конечно не против 🙂 !!!
Опубликовано 14 марта, 20242 г. Только что, Lucky сказал: И ребята может по какому рублю скинем человеку так как он сейчас все эту муть с сайтом разгребает если он конечно не против 🙂 !!! Я про SergioJek !!!
Опубликовано 14 марта, 20242 г. 18 минут назад, Lucky сказал: Я про SergioJek Привет Лаки !!! у тебя очипятка...ник у того кто помог тебе Шурик91
Опубликовано 14 марта, 20242 г. 4 минуты назад, venice сказал: Привет Лаки !!! у тебя очипятка...ник у того кто помог тебе Шурик91 Кстати это еще и афигительный не только мастер но и чел...в отличии от ника который ты назвал ранее.Зделал мне классные таблички.
Опубликовано 14 марта, 20242 г. 3 минуты назад, venice сказал: Кстати это еще и афигительный не только мастер но и чел...в отличии от ника который ты назвал ранее.Зделал мне классные таблички. Я немного не про то, просто есть такой варик, что сейчас вся стата будет не верной, а тот ник что я назвал. Сейчас проверяет все это чтоб все не перемешалось в таблицах!
Опубликовано 14 марта, 20242 г. 1 минуту назад, Lucky сказал: Я немного не про то, просто есть такой варик, что сейчас вся стата будет не верной, а тот ник что я назвал. Сейчас проверяет все это чтоб все не перемешалось в таблицах! И я конечно не уверен, но считаю что они взаимодействуют! 2 минуты назад, Lucky сказал: Я немного не про то, просто есть такой варик, что сейчас вся стата будет не верной, а тот ник что я назвал. Сейчас проверяет все это чтоб все не перемешалось в таблицах! Я это все к тому огромный ребятам поклон, но долго они не протянут на одном интузиазме!
Опубликовано 14 марта, 20242 г. Постоянный 4 минуты назад, Lucky сказал: Я немного не про то, просто есть такой варик, что сейчас вся стата будет не верной, а тот ник что я назвал. Сейчас проверяет все это чтоб все не перемешалось в таблицах! изменения со стороны флешскора, коснулись только результатов, пока других я не заметил. И если всё сделать аккуратно и не спешить, то данные будут рассчитываться как и раньше.
Опубликовано 14 марта, 20242 г. Постоянный 18 минут назад, venice сказал: Кстати это еще и афигительный не только мастер но и чел...в отличии от ника который ты назвал ранее.Зделал мне классные таблички. спасибо за приятные слова, рад что всё понравилось, благодарю и тебя👍
Опубликовано 14 марта, 20242 г. 17 минут назад, Lucky сказал: И я конечно не уверен, но считаю что они взаимодействуют! Я это все к тому огромный ребятам поклон, но долго они не протянут на одном интузиазме! Нет у меня на это времени. Я давно не занимаюсь заказами со стороны - нет просто столько времени. Все время занимает основная работа.
Присоединяйтесь к обсуждению
Вы можете написать сейчас и зарегистрироваться позже. Если у вас есть аккаунт, авторизуйтесь, чтобы опубликовать от имени своего аккаунта.
Примечание: Ваш пост будет проверен модератором, прежде чем станет видимым.