Sub test_SoccerScore()
Dim sYear$, id$, Tournaments$
sYear = 2019
id = 200
Tournaments = "m92"
Call SoccerScore(sYear$, id$, Tournaments$, [A3])
End Sub
Sub SoccerScore(sYear$, id$, Tournaments$, Optional ByVal Rng As Range)
Dim Link$
Static Http As Object, RE As Object
Link = "http://data.7m.com.cn/team_history_odds_data/" & sYear & "/" & Tournaments & "/" & id & "/index_vn.js"
If Http Is Nothing Then
Set Http = VBA.Interaction.CreateObject("WinHttp.WinHttpRequest.5.1")
Set RE = VBA.Interaction.CreateObject("VBScript.RegExp")
RE.Global = 1
RE.IgnoreCase = 1
RE.MultiLine = 1
RE.Pattern = "var ([A-z]{1}[A-z\d_]{0,255}) = \["
End If
With Http
.Open "GET", Link, False
.Send ""
If .Status = 200 Then
Dim sc As Object, Text$, s$, Ss, I%, j%, C%, R%
Set sc = VBA.Interaction.CreateObject("MSScriptControl.ScriptControl")
Text = VBA.Replace(.responseText, "", "")
With RE
If .test(Text) Then
Dim Ms, M: Set Ms = .Execute(Text)
C = Ms.Count - 1
' For I = 0 To C
' s = s & VBA.IIf(s = "", "", ", ") & Ms(I).SubMatches(0)
' Next
' s = "var arr = [" & s & "];"
's = "var arr = [f_tod_stm, f_tod_bh, f_tod_mn, f_tod_rq, f_tod_rql, f_tod_asc, f_tod_bsc, f_tod_ar, f_tod_br, f_tod_ati, f_tod_atn, f_tod_bti, f_tod_btn, f_tod_worl, f_tod_ha, f_rank_h, f_rank_a];"
s = "var arr = [f_tod_mn, f_tod_stm, f_tod_atn, f_tod_asc, f_tod_btn, f_tod_rq, f_tod_worl,f_rank_h, f_tod_bsc, f_rank_a ];"
With sc
.Language = "JScript"
.AddCode Text & vbNewLine & s & " function setArray(index){" & _
"var dict = new ActiveXObject('Scripting.Dictionary');" & _
"for (var i=0; i < arr[index].length; i++ ){" & _
"var s;" & _
"if (index==3){s=arr[index][i].toString() + ' - ' + arr[index+5][i].toString()}" & _
"else if (index==2 || index==4){s=arr[index][i].toString() + '[' + arr[index+5][i].toString() + ']'}" & _
"else{s=arr[index][i] };" & _
"dict.add(i, s)};" & _
"return dict.items();" & _
"}"
For I = 0 To 6
Ss = .Run("setArray", I)
If R = 0 Then
R = UBound(Ss)
ReDim Total(1 To R + 1, 1 To C + 1)
End If
For j = 0 To R
If I = 6 Then
Total(j + 1, I + 1) = VBA.IIf(Ss(j) = 0, "Win", VBA.IIf(Ss(j) = 3, "Lose", "Draw"))
Else
Total(j + 1, I + 1) = Ss(j)
End If
Next
Next
If Not Rng Is Nothing Then _
Rng(1, 1).Resize(R + 1, C + 1).Value = Total
End With
End If
End With
Set sc = Nothing
End If
End With
End Sub
)
