Mong giúp dữ liệu từ trang web sang excel (1 người xem)

[khanhvinhdai1]

Mn giúp mình xuất dữ liệu từ trang web sang excel (Trang kết qảu xổ số minh Ngoc sang excel)

 

[nguyendang95]

Mn giúp mình xuất dữ liệu từ trang web sang excel (Trang kết qảu xổ số minh Ngoc sang excel)

Trước đây mình từng lấy dữ liệu ở trang này bằng code VBA rồi, định dạng bảng không thống nhất nên rất khó sắp xếp đúng thứ tự khi đưa vào sheet, không biết giờ web có thay đổi gì không.

 

[huhumalu]

Trước đây mình từng lấy dữ liệu ở trang này bằng code VBA rồi, định dạng bảng không thống nhất nên rất khó sắp xếp đúng thứ tự khi đưa vào sheet, không biết giờ web có thay đổi gì không.

Bạn tham khảo thử nhé.

Sub GetXoSoMB()
    Dim HttpRequest As Object
    Dim url As String
    Dim html As Object
    Dim objClass As Object
    Dim DataRaw As Object
    Dim prizeClasses As Variant
    Dim results As Object
    Dim result As Object
    Dim i As Integer, j As Integer
   
    Set HttpRequest = CreateObject("MSXML2.ServerXMLHTTP.6.0")
   
    Dim kdate As Date
    If Hour(Now()) > 18 Then
        kdate = Now()
    Else
        kdate = Now() - 1
    End If
   
    url = "https://www.minhngoc.net/ket-qua-xo-so/mien-bac/" & Format(kdate, "dd-mm-yyyy") & ".html"
    '& Day(kdate) & "-" & Month(kdate) & "-" & Year(kdate) & ".html"
   
    HttpRequest.Open "GET", url, False
    HttpRequest.send
   
    ' Load HTML
    Set html = CreateObject("HTMLFile")
    html.body.innerHTML = HttpRequest.responseText
   
    For Each objClass In html.getElementsByTagName("div")
        If objClass.className = "box_kqxs" Then
            Set DataRaw = objClass
            Exit For
        End If
    Next objClass
   
    If DataRaw Is Nothing Then
        MsgBox "No Data!", vbExclamation
        Exit Sub
    End If
   
    prizeClasses = Array("giaidb", "giai1", "giai2", "giai3", "giai4", "giai5", "giai6", "giai7")
   
    Dim resultsArray() As String
    ReDim resultsArray(UBound(prizeClasses))
   
    For i = LBound(prizeClasses) To UBound(prizeClasses)
        For Each result In DataRaw.getElementsByTagName("td")
            If result.className = prizeClasses(i) Then
                  resultsArray(i) = result.innerText
            End If
        Next result
    Next i
   
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("XoSoMB")
   
    ws.Range("A1").Value = "ngay"
    ws.Range("A2").Value = Format(kdate, "dd/mm/yyyy")
   
    ws.Range("B1").Resize(1, 8) = prizeClasses
    ws.Range("B2").Resize(1, 8) = resultsArray

    MsgBox "LoadDone!", vbInformation

End Sub

 

[nguyendang95]

Bạn tham khảo thử nhé.

Sub GetXoSoMB()
    Dim HttpRequest As Object
    Dim url As String
    Dim html As Object
    Dim objClass As Object
    Dim DataRaw As Object
    Dim prizeClasses As Variant
    Dim results As Object
    Dim result As Object
    Dim i As Integer, j As Integer
  
    Set HttpRequest = CreateObject("MSXML2.ServerXMLHTTP.6.0")
  
    Dim kdate As Date
    If Hour(Now()) > 18 Then
        kdate = Now()
    Else
        kdate = Now() - 1
    End If
  
    url = "https://www.minhngoc.net/ket-qua-xo-so/mien-bac/" & Format(kdate, "dd-mm-yyyy") & ".html"
    '& Day(kdate) & "-" & Month(kdate) & "-" & Year(kdate) & ".html"
  
    HttpRequest.Open "GET", url, False
    HttpRequest.send
  
    ' Load HTML
    Set html = CreateObject("HTMLFile")
    html.body.innerHTML = HttpRequest.responseText
  
    For Each objClass In html.getElementsByTagName("div")
        If objClass.className = "box_kqxs" Then
            Set DataRaw = objClass
            Exit For
        End If
    Next objClass
  
    If DataRaw Is Nothing Then
        MsgBox "No Data!", vbExclamation
        Exit Sub
    End If
  
    prizeClasses = Array("giaidb", "giai1", "giai2", "giai3", "giai4", "giai5", "giai6", "giai7")
  
    Dim resultsArray() As String
    ReDim resultsArray(UBound(prizeClasses))
  
    For i = LBound(prizeClasses) To UBound(prizeClasses)
        For Each result In DataRaw.getElementsByTagName("td")
            If result.className = prizeClasses(i) Then
                  resultsArray(i) = result.innerText
            End If
        Next result
    Next i
  
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("XoSoMB")
  
    ws.Range("A1").Value = "ngay"
    ws.Range("A2").Value = Format(kdate, "dd/mm/yyyy")
  
    ws.Range("B1").Resize(1, 8) = prizeClasses
    ws.Range("B2").Resize(1, 8) = resultsArray

    MsgBox "LoadDone!", vbInformation

End Sub

À may vẫn còn chạy.

 

[HeSanbi]

Tôi có viết ứng dụng tải kqsx, nhưng khuyên mọi người không nên tận dụng chúng để phân tích để chơi lô đề. Vì "mất phước" theo luật "rể cây lá cành hoa quả".

Chủ đề 'Dò vé số 3 miền, và thu thập kết quả sổ xố siêu nhanh với Excel'

14/9/21

*** Ứng dụng Bài viết giúp các bạn học và tham khảo code VBA hiệu quả ***

Hôm nay tôi chia sẻ cho những ai đam mê mua vé số nhưng muốn dò vé số nhanh chóng với ứng dụng Excel, thì đã có ứng dụng dò kết quả xổ số 3 miền dưới đây giúp các bạn đơn giản hóa việc dò vé số cũng như thu thập kết quả xổ sổ 3 miền nhanh chóng.

Ứng dụng rất dễ dàng sử dụng:

1. Có nút Cập nhật tay để cập nhật kết quả
2. Chọn một dữ liệu trong bảng kết quả để bắt đầu dò

Ứng dụng chỉ được phát triển ở cấp độ đơn giản, chưa hoàn thiện, nếu các bạn sử dụng cảm thấy khó khăn thì các bạn có thể đóng góp ý...

• HeSanbi
• dò vé số kết quả xổ số loto
• Trả lời: 15
• Diễn đàn: Chơi Game với Excel

• 
•