РЕМОНТ ТАБЛИЦ

[Валерий Иванович 687]

1 час назад, Burn Marlon сказал:

Жаль пощупать нельзя, хотя-бы сделаи выгрзку 1 денька в xslx формате

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

Вот так

wsList.Range("Q" & rw).value = Format(prob_home_e * 100, "0.0")
wsList.Range("R" & rw).value = Format(prob_draw_e * 100, "0.0")
wsList.Range("S" & rw).value = Format(prob_away_e * 100, "0.0")
wsList.Range("T" & rw).value = Format(prob_tb_e * 100, "0.0")
wsList.Range("U" & rw).value = Format(prob_btts_e * 100, "0.0")

Предварительно вызвав его перед записью:

' Система Распределений (Историческая)
Dim lastResults As Variant: lastResults = GetLastResults(wsHome, wsAway)
Dim scoredHome() As Variant: scoredHome = lastResults(1)
Dim missedHome() As Variant: missedHome = lastResults(2)
Dim scoredAway() As Variant: scoredAway = lastResults(3)
Dim missedAway() As Variant: missedAway = lastResults(4)
Dim sirResults As Variant: sirResults = CalculateSIR(scoredHome, missedHome, scoredAway, missedAway, tournamentType)
Dim lambda_home_e As Double: lambda_home_e = sirResults(1)
Dim lambda_away_e As Double: lambda_away_e = sirResults(2)
Dim prob_home_e As Double: prob_home_e = sirResults(3)
Dim prob_draw_e As Double: prob_draw_e = sirResults(4)
Dim prob_away_e As Double: prob_away_e = sirResults(5)
Dim prob_tb_e As Double: prob_tb_e = sirResults(6)
Dim prob_tm_e As Double: prob_tm_e = sirResults(7)
Dim prob_btts_e As Double: prob_btts_e = sirResults(8)
finalPrediction_e = sirResults(9)

Ничего сложного, copy+paste - это все умеют делать ))))

[Валерий Иванович 687]

1 час назад, The Iron Wizard сказал:

А по мне лучше лайв. Настроил бота по своим наблюдением. Посмотрим как покажет дальше.

У меня на сегодняшних матчах только Абсолютный алгоритм показал более-менее что-то достойное.
Это все подряд, без фильтров.

Абсолютное:


Относительное:


Enigma:


МЛ обучение:

[Anatolio 0]

кто-нибудь может испарить ошибку - m_date = DateAdd("s", fs_row2_parts(1), "01/01/1970")

Motivation_v1_1_FX2021_-_kopia(1).xlsb

[Валерий Иванович 687]

3 часа назад, Anatolio сказал:

кто-нибудь может испарить ошибку - m_date = DateAdd("s", fs_row2_parts(1), "01/01/1970")

Motivation_v1_1_FX2021_-_kopia(1).xlsb 403.27 kB · 2 загрузки

Что с ней не так то? )

[Anatolio 0]

Только что, Валерий Иванович сказал:

Что с ней не так то? )

129 игр грузит и ошибка вылетает

[Валерий Иванович 687]

23 минуты назад, Anatolio сказал:

129 игр грузит и ошибка вылетает

Проверяй.

Motivation_v1_1_FX2021_-_kopia(1).xlsb

[Anatolio 0]

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

 

[Валерий Иванович 687]

Только что, Anatolio сказал:

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

 

Из других таблиц (простых) вытащи парсер кефоф, измени названия столбцов - и все норм будет.
Я бы помог, но совет ценнее будет, ибо подарит опыт и знание ) 

[Burn Marlon 290]

10 часов назад, Валерий Иванович сказал:

Из других таблиц (простых) вытащи парсер кефоф,

Я бы хотел вглянуть на ваш код парсер кефов )

[Валерий Иванович 687]

2 часа назад, Burn Marlon сказал:

Я бы хотел вглянуть на ваш код парсер кефов )

Держи, смотри и пользуйся, если разберешься, не жалко, он публичный ))))

 

Public iBook() As String: Public data_json As String: Public odds_json As String: Public openValue As Long

Sub getOdds(match_id, home_id, away_id, rw)
On Error Resume Next
Dim inWs As Worksheet: Set inWs = ActiveSheet
Dim cellBook As Long: cellBook = Sheets("Settings").Range("J1").value
Dim nBook As String
Select Case cellBook
Case 1: nBook = ""
Case 2: nBook = "1xBet"
Case 3: nBook = "bet365"
Case 4: nBook = "Betera"
Case 5: nBook = "Betfair"
Case 6: nBook = "bwin"
Case 7: nBook = "Favbet"
Case 8: nBook = "GGBET"
Case 9: nBook = "Unibet"
Case 10: nBook = "William Hill"
End Select
data_json = Empty: odds_json = Empty
Dim objXMLHTTP As Object: Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
Dim response() As String
objXMLHTTP.Open "GET", "https://global.ds.lsapp.eu/odds/pq_graphql?_hash=oce&eventId=" & match_id & "&projectId=2002&geoIpCode=EN&geoIpSubdivisionCode=EN", False
objXMLHTTP.setRequestHeader "X-Fsign", "SW9D1eZo": objXMLHTTP.Send
response = Split(objXMLHTTP.responseText, "},""odds""")
data_json = response(0): odds_json = response(1)
openValue = 0
Dim objRegExp As Object: Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Global = True: objRegExp.pattern = """Bookmaker"",""id"":(\w+),""name"":""(.*?)"""
Dim objMatches As Object: Set objMatches = objRegExp.Execute(data_json)
Dim cnt As Long: cnt = objMatches.count - 1
Dim b As Long: b = 0
ReDim iBook(cnt)
Dim nBook_t() As String: ReDim nBook_t(cnt)
Dim i As Long
For i = 0 To cnt
iBook(b) = objMatches.item(b).SubMatches(0)
nBook_t(b) = objMatches.item(b).SubMatches(1)
b = b + 1
Next i
If Not IsEmpty(nBook) And Len(nBook) > 1 Then
Dim iBook_t() As String: ReDim iBook_t(UBound(iBook))
For i = 0 To UBound(nBook_t)
If nBook_t(i) = nBook Then
iBook = Array(iBook(i))
Exit For
End If
Next i
End If
Dim outputData() As Variant
Dim access As Variant: access = Sheets("Settings").Range("O2:O20").value
Dim marketCount As Long: marketCount = 0
For i = 1 To 19
If access(i, 1) Then marketCount = marketCount + 1
Next i
If marketCount > 0 Then
ReDim outputData(1 To marketCount, 1 To 7)
marketCount = 0
If access(1, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "AK" & rw
If access(2, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "AQ" & rw
If access(3, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "AW" & rw
If access(4, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "BA" & rw
If access(5, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "BE" & rw
If access(6, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "BI" & rw
If access(7, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "BM" & rw
If access(8, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "BQ" & rw
If access(9, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "BU" & rw
If access(10, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "BY" & rw
If access(11, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "CC" & rw
If access(12, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "CG" & rw
If access(13, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "CK" & rw
If access(14, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "CO" & rw
If access(15, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "CS" & rw
If access(16, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "CW" & rw
If access(17, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "DA" & rw
If access(18, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "DE" & rw
If access(19, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "DI" & rw
For i = 1 To marketCount
Select Case Left(outputData(i, 1), 2)
Case "AK": ProcessMarket "HOME_DRAW_AWAY", Empty, "FULL_TIME", outputData, i, home_id, away_id
Case "AQ": ProcessMarket "DOUBLE_CHANCE", Empty, "FULL_TIME", outputData, i, home_id, away_id
Case "AW": ProcessMarket "OVER_UNDER", "1.5", "FULL_TIME", outputData, i, home_id, away_id
Case "BA": ProcessMarket "OVER_UNDER", "2.5", "FULL_TIME", outputData, i, home_id, away_id
Case "BE": ProcessMarket "OVER_UNDER", "3.5", "FULL_TIME", outputData, i, home_id, away_id
Case "BI": ProcessMarket "BOTH_TEAMS_TO_SCORE", Empty, "FULL_TIME", outputData, i, home_id, away_id
Case "BM": ProcessMarket "OVER_UNDER", "0.5", "FIRST_HALF", outputData, i, home_id, away_id
Case "BQ": ProcessMarket "OVER_UNDER", "1.5", "FIRST_HALF", outputData, i, home_id, away_id
Case "BU": ProcessMarket "OVER_UNDER", "0.5", "SECOND_HALF", outputData, i, home_id, away_id
Case "BY": ProcessMarket "OVER_UNDER", "1.5", "SECOND_HALF", outputData, i, home_id, away_id
Case "CC": ProcessMarket "ASIAN_HANDICAP", "0.0", "FULL_TIME", outputData, i, home_id, away_id
Case "CG": ProcessMarket "ASIAN_HANDICAP", "-2.0", "FULL_TIME", outputData, i, home_id, away_id
Case "CK": ProcessMarket "ASIAN_HANDICAP", "-1.5", "FULL_TIME", outputData, i, home_id, away_id
Case "CO": ProcessMarket "ASIAN_HANDICAP", "-1.0", "FULL_TIME", outputData, i, home_id, away_id
Case "CS": ProcessMarket "ASIAN_HANDICAP", "-0.5", "FULL_TIME", outputData, i, home_id, away_id
Case "CW": ProcessMarket "ASIAN_HANDICAP", "0.5", "FULL_TIME", outputData, i, home_id, away_id
Case "DA": ProcessMarket "ASIAN_HANDICAP", "1.0", "FULL_TIME", outputData, i, home_id, away_id
Case "DE": ProcessMarket "ASIAN_HANDICAP", "1.5", "FULL_TIME", outputData, i, home_id, away_id
Case "DI": ProcessMarket "ASIAN_HANDICAP", "2.0", "FULL_TIME", outputData, i, home_id, away_id
End Select
Next i
For i = 1 To marketCount
With inWs.Range(outputData(i, 1))
Select Case outputData(i, 7)
Case 1:
.Offset(0, 0).value = outputData(i, 2)
.Offset(0, 1).value = outputData(i, 3)
Case 2:
.Offset(0, 0).value = outputData(i, 2)
.Offset(0, 2).value = outputData(i, 3)
.Offset(0, 1).value = outputData(i, 4)
.Offset(0, 3).value = outputData(i, 5)
Case Else:
.Offset(0, 0).value = outputData(i, 2)
.Offset(0, 3).value = outputData(i, 3)
.Offset(0, 1).value = outputData(i, 4)
.Offset(0, 4).value = outputData(i, 5)
.Offset(0, 2).value = outputData(i, 6)
.Offset(0, 5).value = outputData(i, 6)
End Select
inWs.Range("AK" & rw & ":DN" & rw).Font.Color = RGB(222, 222, 222)
End With
Next i
End If
Set objXMLHTTP = Nothing: Set objRegExp = Nothing: Set objMatches = Nothing
End Sub

Sub ProcessMarket(MARKET, SUBM, TIME, ByRef outputData, idx, home_id, away_id)
Dim cnt As Long
Select Case MARKET
Case "HOME_DRAW_AWAY", "DOUBLE_CHANCE", "EUROPEAN_HANDICAP": cnt = 3
Case "CORRECT_SCORE", "HALF_FULL_TIME": cnt = 1
Case Else: cnt = 2
End Select
outputData(idx, 7) = cnt
Dim objRegExp As Object: Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Global = True: objRegExp.pattern = "\{""__typename"":""EventOdds"",""bookmakerId"":\w+,""bettingType"":""" & MARKET & """,""bettingScope"":""" & TIME & """.*?\}\]\}"
Dim objMatches As Object: Set objMatches = objRegExp.Execute(odds_json)
Dim s_11 As Variant, s_21 As Variant, s_31 As Variant
Dim c_11 As Variant, c_21 As Variant, c_31 As Variant
Dim s_12 As Variant, s_22 As Variant, s_32 As Variant
Dim c_12 As Variant, c_22 As Variant, c_32 As Variant
s_11 = Empty: s_21 = Empty: s_31 = Empty
c_11 = Empty: c_21 = Empty: c_31 = Empty
s_12 = Empty: s_22 = Empty: s_32 = Empty
c_12 = Empty: c_22 = Empty: c_32 = Empty
Dim b As Long
For b = 0 To UBound(iBook)
Dim iBook_t As String: iBook_t = iBook(b)
If Not IsEmpty(iBook_t) Then
Dim nBook_t As Object
For Each nBook_t In objMatches
Dim odds_json_t As String: odds_json_t = nBook_t.value
If InStr(odds_json_t, """bookmakerId"":" & iBook_t) > 0 Then
Dim KFS As Variant: KFS = Split(odds_json_t, """EventOddsItem""")
Dim x As Long: x = 0
If (UBound(KFS) - LBound(KFS)) < 1 Then Exit For
Dim k As Long
For k = 1 To UBound(KFS)
Dim team_id As String: team_id = Empty
Dim t1 As Variant: t1 = Empty
Dim t2 As Variant: t2 = Empty
Dim KF As String: KF = KFS(k)
If MARKET = "OVER_UNDER" Or InStr(MARKET, "HANDICAP") > 0 Then
Dim HC As Variant: HC = Split(KF, "handicap")
If (UBound(HC) - LBound(HC)) < 1 Then GoTo next_h
KF = HC(0): HC = HC(1)
If MARKET = "ASIAN_HANDICAP" Then
Dim submVal As Double: submVal = val(SUBM)
Dim RSUBM As String
If submVal = Int(submVal) Then
RSUBM = Replace(Format(-submVal, "0.0"), ",", ".")
SUBM = Replace(Format(submVal, "0.0"), ",", ".")
Else
RSUBM = Replace(-submVal, ",", ".")
SUBM = Replace(SUBM, ",", ".")
End If
If RSUBM <> "0.0" Then
If InStr(HC, """" & SUBM & """") = 0 Then
If InStr(HC, """" & RSUBM & """") = 0 Then
GoTo next_h
Else
If InStr(KF, away_id) = 0 Then GoTo next_h
End If
Else
If InStr(KF, home_id) = 0 Then GoTo next_h
End If
Else
If InStr(HC, """" & SUBM & """") = 0 Then GoTo next_h
End If
Else
If InStr(HC, """" & SUBM & """") = 0 Then GoTo next_h
End If
ElseIf Not IsEmpty(SUBM) Then
If InStr(KF, SUBM) = 0 Then GoTo next_h
End If
If (openValue = 1 And InStr(KF, "active"":true") < 1) Then Exit For
Dim rs As Variant: rs = Split(KF, ",")
Dim r As Long
For r = 0 To UBound(rs)
Dim VV As Variant: VV = Split(rs(r), ":")
If (UBound(VV) - LBound(VV)) > 0 Then
Dim item As String: item = Replace(VV(0), """", "")
Dim v As String: v = Replace(VV(1), """", "")
If item = "eventParticipantId" Then team_id = v
Select Case x
Case 0:
If item = "opening" Then s_12 = v: t1 = v
If item = "value" Then c_12 = v: t2 = v
Case 1:
If item = "opening" Then s_22 = v: t1 = v
If item = "value" Then c_22 = v: t2 = v
Case 2:
If item = "opening" Then s_32 = v: t1 = v
If item = "value" Then c_32 = v: t2 = v
End Select
End If
Next r
If team_id = home_id Then
s_11 = t1: c_11 = t2
ElseIf team_id = away_id Then
s_31 = t1: c_31 = t2
Else
s_21 = t1: c_21 = t2
End If
x = x + 1
If (x = cnt And (s_11 & s_12) <> "") Then Exit For
next_h:
Next k
Exit For
End If
Next nBook_t
End If
Next b
s_12 = IIf(IsEmpty(s_11), s_12, s_11)
c_12 = IIf(IsEmpty(c_11), c_12, c_11)
s_22 = IIf(IsEmpty(s_21), s_22, s_21)
c_22 = IIf(IsEmpty(c_21), c_22, c_21)
s_32 = IIf(IsEmpty(s_31), s_32, s_31)
c_32 = IIf(IsEmpty(c_31), c_32, c_31)
If MARKET = "ASIAN_HANDICAP" Then s_22 = s_32: c_22 = c_32
outputData(idx, 2) = s_12
outputData(idx, 3) = c_12
outputData(idx, 4) = s_22
outputData(idx, 5) = c_22
outputData(idx, 6) = s_32
Set objRegExp = Nothing: Set objMatches = Nothing
End Sub

Настройки:


Результаты:

[The Iron Wizard 1 584]

57 минут назад, Валерий Иванович сказал:

Держи, смотри и пользуйся, если разберешься, не жалко, он публичный ))))

 

Public iBook() As String: Public data_json As String: Public odds_json As String: Public openValue As Long

Sub getOdds(match_id, home_id, away_id, rw)
On Error Resume Next
Dim inWs As Worksheet: Set inWs = ActiveSheet
Dim cellBook As Long: cellBook = Sheets("Settings").Range("J1").value
Dim nBook As String
Select Case cellBook
Case 1: nBook = ""
Case 2: nBook = "1xBet"
Case 3: nBook = "bet365"
Case 4: nBook = "Betera"
Case 5: nBook = "Betfair"
Case 6: nBook = "bwin"
Case 7: nBook = "Favbet"
Case 8: nBook = "GGBET"
Case 9: nBook = "Unibet"
Case 10: nBook = "William Hill"
End Select
data_json = Empty: odds_json = Empty
Dim objXMLHTTP As Object: Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
Dim response() As String
objXMLHTTP.Open "GET", "https://global.ds.lsapp.eu/odds/pq_graphql?_hash=oce&eventId=" & match_id & "&projectId=2002&geoIpCode=EN&geoIpSubdivisionCode=EN", False
objXMLHTTP.setRequestHeader "X-Fsign", "SW9D1eZo": objXMLHTTP.Send
response = Split(objXMLHTTP.responseText, "},""odds""")
data_json = response(0): odds_json = response(1)
openValue = 0
Dim objRegExp As Object: Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Global = True: objRegExp.pattern = """Bookmaker"",""id"":(\w+),""name"":""(.*?)"""
Dim objMatches As Object: Set objMatches = objRegExp.Execute(data_json)
Dim cnt As Long: cnt = objMatches.count - 1
Dim b As Long: b = 0
ReDim iBook(cnt)
Dim nBook_t() As String: ReDim nBook_t(cnt)
Dim i As Long
For i = 0 To cnt
iBook(b) = objMatches.item(b).SubMatches(0)
nBook_t(b) = objMatches.item(b).SubMatches(1)
b = b + 1
Next i
If Not IsEmpty(nBook) And Len(nBook) > 1 Then
Dim iBook_t() As String: ReDim iBook_t(UBound(iBook))
For i = 0 To UBound(nBook_t)
If nBook_t(i) = nBook Then
iBook = Array(iBook(i))
Exit For
End If
Next i
End If
Dim outputData() As Variant
Dim access As Variant: access = Sheets("Settings").Range("O2:O20").value
Dim marketCount As Long: marketCount = 0
For i = 1 To 19
If access(i, 1) Then marketCount = marketCount + 1
Next i
If marketCount > 0 Then
ReDim outputData(1 To marketCount, 1 To 7)
marketCount = 0
If access(1, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "AK" & rw
If access(2, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "AQ" & rw
If access(3, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "AW" & rw
If access(4, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "BA" & rw
If access(5, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "BE" & rw
If access(6, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "BI" & rw
If access(7, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "BM" & rw
If access(8, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "BQ" & rw
If access(9, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "BU" & rw
If access(10, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "BY" & rw
If access(11, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "CC" & rw
If access(12, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "CG" & rw
If access(13, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "CK" & rw
If access(14, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "CO" & rw
If access(15, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "CS" & rw
If access(16, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "CW" & rw
If access(17, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "DA" & rw
If access(18, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "DE" & rw
If access(19, 1) Then marketCount = marketCount + 1: outputData(marketCount, 1) = "DI" & rw
For i = 1 To marketCount
Select Case Left(outputData(i, 1), 2)
Case "AK": ProcessMarket "HOME_DRAW_AWAY", Empty, "FULL_TIME", outputData, i, home_id, away_id
Case "AQ": ProcessMarket "DOUBLE_CHANCE", Empty, "FULL_TIME", outputData, i, home_id, away_id
Case "AW": ProcessMarket "OVER_UNDER", "1.5", "FULL_TIME", outputData, i, home_id, away_id
Case "BA": ProcessMarket "OVER_UNDER", "2.5", "FULL_TIME", outputData, i, home_id, away_id
Case "BE": ProcessMarket "OVER_UNDER", "3.5", "FULL_TIME", outputData, i, home_id, away_id
Case "BI": ProcessMarket "BOTH_TEAMS_TO_SCORE", Empty, "FULL_TIME", outputData, i, home_id, away_id
Case "BM": ProcessMarket "OVER_UNDER", "0.5", "FIRST_HALF", outputData, i, home_id, away_id
Case "BQ": ProcessMarket "OVER_UNDER", "1.5", "FIRST_HALF", outputData, i, home_id, away_id
Case "BU": ProcessMarket "OVER_UNDER", "0.5", "SECOND_HALF", outputData, i, home_id, away_id
Case "BY": ProcessMarket "OVER_UNDER", "1.5", "SECOND_HALF", outputData, i, home_id, away_id
Case "CC": ProcessMarket "ASIAN_HANDICAP", "0.0", "FULL_TIME", outputData, i, home_id, away_id
Case "CG": ProcessMarket "ASIAN_HANDICAP", "-2.0", "FULL_TIME", outputData, i, home_id, away_id
Case "CK": ProcessMarket "ASIAN_HANDICAP", "-1.5", "FULL_TIME", outputData, i, home_id, away_id
Case "CO": ProcessMarket "ASIAN_HANDICAP", "-1.0", "FULL_TIME", outputData, i, home_id, away_id
Case "CS": ProcessMarket "ASIAN_HANDICAP", "-0.5", "FULL_TIME", outputData, i, home_id, away_id
Case "CW": ProcessMarket "ASIAN_HANDICAP", "0.5", "FULL_TIME", outputData, i, home_id, away_id
Case "DA": ProcessMarket "ASIAN_HANDICAP", "1.0", "FULL_TIME", outputData, i, home_id, away_id
Case "DE": ProcessMarket "ASIAN_HANDICAP", "1.5", "FULL_TIME", outputData, i, home_id, away_id
Case "DI": ProcessMarket "ASIAN_HANDICAP", "2.0", "FULL_TIME", outputData, i, home_id, away_id
End Select
Next i
For i = 1 To marketCount
With inWs.Range(outputData(i, 1))
Select Case outputData(i, 7)
Case 1:
.Offset(0, 0).value = outputData(i, 2)
.Offset(0, 1).value = outputData(i, 3)
Case 2:
.Offset(0, 0).value = outputData(i, 2)
.Offset(0, 2).value = outputData(i, 3)
.Offset(0, 1).value = outputData(i, 4)
.Offset(0, 3).value = outputData(i, 5)
Case Else:
.Offset(0, 0).value = outputData(i, 2)
.Offset(0, 3).value = outputData(i, 3)
.Offset(0, 1).value = outputData(i, 4)
.Offset(0, 4).value = outputData(i, 5)
.Offset(0, 2).value = outputData(i, 6)
.Offset(0, 5).value = outputData(i, 6)
End Select
inWs.Range("AK" & rw & ":DN" & rw).Font.Color = RGB(222, 222, 222)
End With
Next i
End If
Set objXMLHTTP = Nothing: Set objRegExp = Nothing: Set objMatches = Nothing
End Sub

Sub ProcessMarket(MARKET, SUBM, TIME, ByRef outputData, idx, home_id, away_id)
Dim cnt As Long
Select Case MARKET
Case "HOME_DRAW_AWAY", "DOUBLE_CHANCE", "EUROPEAN_HANDICAP": cnt = 3
Case "CORRECT_SCORE", "HALF_FULL_TIME": cnt = 1
Case Else: cnt = 2
End Select
outputData(idx, 7) = cnt
Dim objRegExp As Object: Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Global = True: objRegExp.pattern = "\{""__typename"":""EventOdds"",""bookmakerId"":\w+,""bettingType"":""" & MARKET & """,""bettingScope"":""" & TIME & """.*?\}\]\}"
Dim objMatches As Object: Set objMatches = objRegExp.Execute(odds_json)
Dim s_11 As Variant, s_21 As Variant, s_31 As Variant
Dim c_11 As Variant, c_21 As Variant, c_31 As Variant
Dim s_12 As Variant, s_22 As Variant, s_32 As Variant
Dim c_12 As Variant, c_22 As Variant, c_32 As Variant
s_11 = Empty: s_21 = Empty: s_31 = Empty
c_11 = Empty: c_21 = Empty: c_31 = Empty
s_12 = Empty: s_22 = Empty: s_32 = Empty
c_12 = Empty: c_22 = Empty: c_32 = Empty
Dim b As Long
For b = 0 To UBound(iBook)
Dim iBook_t As String: iBook_t = iBook(b)
If Not IsEmpty(iBook_t) Then
Dim nBook_t As Object
For Each nBook_t In objMatches
Dim odds_json_t As String: odds_json_t = nBook_t.value
If InStr(odds_json_t, """bookmakerId"":" & iBook_t) > 0 Then
Dim KFS As Variant: KFS = Split(odds_json_t, """EventOddsItem""")
Dim x As Long: x = 0
If (UBound(KFS) - LBound(KFS)) < 1 Then Exit For
Dim k As Long
For k = 1 To UBound(KFS)
Dim team_id As String: team_id = Empty
Dim t1 As Variant: t1 = Empty
Dim t2 As Variant: t2 = Empty
Dim KF As String: KF = KFS(k)
If MARKET = "OVER_UNDER" Or InStr(MARKET, "HANDICAP") > 0 Then
Dim HC As Variant: HC = Split(KF, "handicap")
If (UBound(HC) - LBound(HC)) < 1 Then GoTo next_h
KF = HC(0): HC = HC(1)
If MARKET = "ASIAN_HANDICAP" Then
Dim submVal As Double: submVal = val(SUBM)
Dim RSUBM As String
If submVal = Int(submVal) Then
RSUBM = Replace(Format(-submVal, "0.0"), ",", ".")
SUBM = Replace(Format(submVal, "0.0"), ",", ".")
Else
RSUBM = Replace(-submVal, ",", ".")
SUBM = Replace(SUBM, ",", ".")
End If
If RSUBM <> "0.0" Then
If InStr(HC, """" & SUBM & """") = 0 Then
If InStr(HC, """" & RSUBM & """") = 0 Then
GoTo next_h
Else
If InStr(KF, away_id) = 0 Then GoTo next_h
End If
Else
If InStr(KF, home_id) = 0 Then GoTo next_h
End If
Else
If InStr(HC, """" & SUBM & """") = 0 Then GoTo next_h
End If
Else
If InStr(HC, """" & SUBM & """") = 0 Then GoTo next_h
End If
ElseIf Not IsEmpty(SUBM) Then
If InStr(KF, SUBM) = 0 Then GoTo next_h
End If
If (openValue = 1 And InStr(KF, "active"":true") < 1) Then Exit For
Dim rs As Variant: rs = Split(KF, ",")
Dim r As Long
For r = 0 To UBound(rs)
Dim VV As Variant: VV = Split(rs(r), ":")
If (UBound(VV) - LBound(VV)) > 0 Then
Dim item As String: item = Replace(VV(0), """", "")
Dim v As String: v = Replace(VV(1), """", "")
If item = "eventParticipantId" Then team_id = v
Select Case x
Case 0:
If item = "opening" Then s_12 = v: t1 = v
If item = "value" Then c_12 = v: t2 = v
Case 1:
If item = "opening" Then s_22 = v: t1 = v
If item = "value" Then c_22 = v: t2 = v
Case 2:
If item = "opening" Then s_32 = v: t1 = v
If item = "value" Then c_32 = v: t2 = v
End Select
End If
Next r
If team_id = home_id Then
s_11 = t1: c_11 = t2
ElseIf team_id = away_id Then
s_31 = t1: c_31 = t2
Else
s_21 = t1: c_21 = t2
End If
x = x + 1
If (x = cnt And (s_11 & s_12) <> "") Then Exit For
next_h:
Next k
Exit For
End If
Next nBook_t
End If
Next b
s_12 = IIf(IsEmpty(s_11), s_12, s_11)
c_12 = IIf(IsEmpty(c_11), c_12, c_11)
s_22 = IIf(IsEmpty(s_21), s_22, s_21)
c_22 = IIf(IsEmpty(c_21), c_22, c_21)
s_32 = IIf(IsEmpty(s_31), s_32, s_31)
c_32 = IIf(IsEmpty(c_31), c_32, c_31)
If MARKET = "ASIAN_HANDICAP" Then s_22 = s_32: c_22 = c_32
outputData(idx, 2) = s_12
outputData(idx, 3) = c_12
outputData(idx, 4) = s_22
outputData(idx, 5) = c_22
outputData(idx, 6) = s_32
Set objRegExp = Nothing: Set objMatches = Nothing
End Sub

Настройки:


Результаты:

Я как понимаю Shurik91 дал начало, а Вы продолжили...

[Валерий Иванович 687]

31 минуту назад, The Iron Wizard сказал:

Я как понимаю Shurik91 дал начало, а Вы продолжили...

Все верно )