Lấy dữ liệu trên web

[Hanh.nt]

Xin chào các anh chị,
Em muốn lấy dữ liệu từ web "http://data.7m.com.cn/team_history_odds_data/2019/m92/200/total/index_vn.htm" bằng vba. Em dùng "Set hTable = .getElementById("team_odds_away_tb")" để lấy dữ liệu bảng, tiếp đó là "Set trs = hTable.getElementsByTagName("tr")" để lấy dữ liệu các dòng, trên web là có tổng cộng 40 dòng nhưng em chỉ lấy được 2 dòng đầu, em chưa biết nguyên nhân vì sao. Các anh chị xem file đính kèm và giúp em với ạ

 

[HeSanbi]

Bạn ngóng đợi "Thần thánh phương khác" xem có giúp bạn tốt hơn không!

Thử sửa lại Set sc = VBA.Interaction.CreateObject("ScriptControl")

Cách khác:
---------------

Sub test_SoccerScore2()
  Dim sYear$, id$, Tournaments$
  sYear = 2019
  id = 200
  Tournaments = "m92"
  Call SoccerScore2(sYear$, id$, Tournaments$, [A3])
End Sub
Sub SoccerScore2(sYear$, id$, Tournaments$, Optional ByVal Rng As Range)
  Dim Link$
  On Error Resume Next
  Dim Http As Object, RE As Object, F_
  Link = "http://data.7m.com.cn/team_history_odds_data/" & sYear & "/" & Tournaments & "/" & id & "/index_vn.js"

  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
  With Http
    .Open "GET", Link, False
    .send ""
    Dim Text$, I%, j%, R%
    Text = .responseText
    RE.Pattern = "(?:var +(?:(?:f_tod_(?:(?:stm)|(?:mn)|(?:asc)|(?:rq)|(?:worl)|(?:atn)|(?:btn)|(?:bsc)))" & _
       "|(?:f_rank_(?:h|a))) *= *\[ *)" & "((?:'?[0-9A-z\s.:%&\-_\""]*'?\s*,?)+)\]"
    If RE.test(Text) Then
      Dim Ms, Ms2, Ms3, Tmp$: Set Ms = RE.Execute(Text)
      RE.Pattern = "[0-9A-z\s.:%&\-_]+|'{2}"
      F_ = Array(1, 0, 5, 3, 6, 2, 7, 8, 4, 9)
      For I = 0 To 6
        Set Ms2 = RE.Execute(Ms(F_(I)).SubMatches(0))
        If R = 0 Then
          R = Ms2.Count
          ReDim Total(1 To R, 1 To 7)
        End If
        For j = 0 To R - 1
          If I = 2 Or I = 3 Or I = 4 Then
            Set Ms3 = RE.Execute(Ms(F_(I + 5)).SubMatches(0))
            If I = 3 Then
              Total(j + 1, I + 1) = "'" & Ms2(j) & " - " & Ms3(j)
            Else
              Total(j + 1, I + 1) = Ms2(j) & VBA.IIf(Ms3(j) = "''", "", "[" & Ms3(j) & "]")
            End If
          ElseIf I = 6 Then
            Total(j + 1, I + 1) = VBA.IIf(Ms2(j) = 0, "Win", VBA.IIf(Ms2(j) = 3, "Lose", "Draw"))
          Else
            Total(j + 1, I + 1) = Ms2(j)
          End If
        Next
      Next
      If Not Rng Is Nothing Then _
        Rng.Resize(R, 7).Value = Total
    End If
    Set sc = Nothing
  End With
End Sub

 

[Hanh.nt]

Bạn ngóng đợi "Thần thánh phương khác" xem có giúp bạn tốt hơn không!

Thử sửa lại Set sc = VBA.Interaction.CreateObject("ScriptControl")

Cách khác:
---------------

Sub test_SoccerScore2()
  Dim sYear$, id$, Tournaments$
  sYear = 2019
  id = 200
  Tournaments = "m92"
  Call SoccerScore2(sYear$, id$, Tournaments$, [A3])
End Sub
Sub SoccerScore2(sYear$, id$, Tournaments$, Optional ByVal Rng As Range)
  Dim Link$
  On Error Resume Next
  Dim Http As Object, RE As Object, F_
  Link = "http://data.7m.com.cn/team_history_odds_data/" & sYear & "/" & Tournaments & "/" & id & "/index_vn.js"

  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
  With Http
    .Open "GET", Link, False
    .send ""
    Dim Text$, I%, j%, R%
    Text = .responseText
    RE.Pattern = "(?:var +(?:(?:f_tod_(?:(?:stm)|(?:mn)|(?:asc)|(?:rq)|(?:worl)|(?:atn)|(?:btn)|(?:bsc)))" & _
       "|(?:f_rank_(?:h|a))) *= *\[ *)" & "((?:'?[0-9A-z\s.:%&\-_\""]*'?\s*,?)+)\]"
    If RE.test(Text) Then
      Dim Ms, Ms2, Ms3, Tmp$: Set Ms = RE.Execute(Text)
      RE.Pattern = "[0-9A-z\s.:%&\-_]+|'{2}"
      F_ = Array(1, 0, 5, 3, 6, 2, 7, 8, 4, 9)
      For I = 0 To 6
        Set Ms2 = RE.Execute(Ms(F_(I)).SubMatches(0))
        If R = 0 Then
          R = Ms2.Count
          ReDim Total(1 To R, 1 To 7)
        End If
        For j = 0 To R - 1
          If I = 2 Or I = 3 Or I = 4 Then
            Set Ms3 = RE.Execute(Ms(F_(I + 5)).SubMatches(0))
            If I = 3 Then
              Total(j + 1, I + 1) = "'" & Ms2(j) & " - " & Ms3(j)
            Else
              Total(j + 1, I + 1) = Ms2(j) & VBA.IIf(Ms3(j) = "''", "", "[" & Ms3(j) & "]")
            End If
          ElseIf I = 6 Then
            Total(j + 1, I + 1) = VBA.IIf(Ms2(j) = 0, "Win", VBA.IIf(Ms2(j) = 3, "Lose", "Draw"))
          Else
            Total(j + 1, I + 1) = Ms2(j)
          End If
        Next
      Next
      If Not Rng Is Nothing Then _
        Rng.Resize(R, 7).Value = Total
    End If
    Set sc = Nothing
  End With
End Sub

Chạy ngon rồi bác ạ. Em cảm ơn bác nhiều.

Bác có phải là dân chứng khoán không ạ?

 

[hongfxhp]

Chạy ngon rồi bác ạ. Em cảm ơn bác nhiều.

Bác có phải là dân chứng khoán không ạ?

Bạn là dân chứng khoán ah? Mình cũng mới chơi có gì giao lưu học hỏi kinh nghiệm được không ban?