从无识别表格的网页抓取实时数据至Excel的宏实现需求

嘿，太懂你这种头疼的感觉了——Excel自带的Get Data根本识别不了目标表格，手动处理这么多页面完全不现实。别慌，咱们用VBA写个宏就能批量搞定，下面给你一套落地的方案：

核心思路 #

• 用VBA模拟浏览器访问目标网页（适配动态加载的博彩网站）
• 精准定位页面中的赔率表格元素
• 自动将表格数据写入Excel工作表
• 支持传入URL列表批量处理不同博彩公司的数据

完整VBA代码示例 #

Sub 批量抓取赔率数据()
    Dim IE As Object
    Dim ws As Worksheet
    Dim tbl As Object
    Dim rowNum As Integer, colNum As Integer
    Dim urlList As Variant
    Dim currentUrl As Variant
    
    ' 替换成你的URL列表：可以直接写数组，也可以从Excel列读取（见下文说明）
    urlList = Array("http://你的示例链接1", "http://你的示例链接2", "http://更多目标链接")
    
    ' 创建新工作表存放汇总数据
    Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = "赔率数据汇总"
    rowNum = 1 ' 数据起始行
    
    ' 初始化浏览器对象（隐藏窗口加快抓取速度）
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = False
    
    For Each currentUrl In urlList
        IE.Navigate currentUrl
        
        ' 等待页面完全加载（处理动态渲染内容）
        Do While IE.Busy Or IE.ReadyState <> 4
            DoEvents
        Loop
        ' 若页面是AJAX动态加载，可增加等待时间：Application.Wait Now + TimeValue("00:00:02")
        
        ' 定位目标表格——需根据实际页面HTML结构调整！
        ' 示例：通过表格ID定位，若用类名则改为 getElementsByClassName("你的表格类名")(0)
        On Error Resume Next ' 防止找不到表格导致程序崩溃
        Set tbl = IE.Document.getElementById("odds-table")
        On Error GoTo 0
        
        If Not tbl Is Nothing Then
            ' 写入当前URL作为数据来源标识
            ws.Cells(rowNum, 1).Value = "来源：" & currentUrl
            rowNum = rowNum + 1
            
            ' 遍历表格行和列，写入Excel
            For Each row In tbl.Rows
                colNum = 1
                For Each cell In row.Cells
                    ws.Cells(rowNum, colNum).Value = cell.innerText
                    colNum = colNum + 1
                Next cell
                rowNum = rowNum + 1
            Next row
            
            ' 空一行分隔不同网站的数据
            rowNum = rowNum + 1
            Set tbl = Nothing
        Else
            ' 记录抓取失败的URL
            ws.Cells(rowNum, 1).Value = "抓取失败：" & currentUrl & " 未找到目标表格"
            rowNum = rowNum + 2
        End If
    Next currentUrl
    
    ' 清理资源
    IE.Quit
    Set IE = Nothing
    Set ws = Nothing
    
    MsgBox "批量抓取完成！", vbInformation
End Sub

关键配置说明 #

1. 调整表格定位代码
   打开目标网页的开发者工具（按F12），找到赔率表格的HTML元素：

   • 如果表格有ID（比如<table id="bet-odds-table">），就把代码里的getElementById("odds-table")改成getElementById("bet-odds-table")
   • 如果表格用类名标识（比如<table class="sports-odds">），则改为getElementsByClassName("sports-odds")(0)（注意索引从0开始）

2. 灵活加载URL列表
   如果你的URL存放在Excel某一列（比如Sheet1的A列），可以把urlList = Array(...)替换成：

   urlList = Sheet1.Range("A1:A" & Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row).Value
   

   这样就能自动读取所有URL，不用手动写数组。

3. 处理动态加载页面
   很多博彩网站用AJAX动态加载数据，单纯等待浏览器就绪可能抓不到内容。可以在Do While IE.Busy...循环后添加：

   Application.Wait Now + TimeValue("00:00:02") ' 等待2秒，可按需调整时长
   

替代方案（静态页面适用） #

如果目标页面是纯静态HTML，也可以用XMLHTTP直接抓取源码，速度更快：

Sub 静态页面抓取()
    Dim xmlHttp As Object
    Dim htmlDoc As Object
    Dim tbl As Object
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    xmlHttp.Open "GET", "http://你的目标URL", False
    xmlHttp.Send
    
    Set htmlDoc = CreateObject("HTMLFile")
    htmlDoc.Write xmlHttp.responseText
    
    ' 后续定位表格的代码和上面一致
    Set tbl = htmlDoc.getElementById("odds-table")
    ' ...（省略写入Excel的逻辑）
End Sub

内容的提问来源于stack exchange，提问作者Issy the kid