VBA 操作网页读取数据自动填入 EXCEL 表中 Sub a 正式查分程序() ’运行时会出现错误提示，中止程序，更改 j 初值后重新运行 Dim ie， dmt Dim i, j, k, bb， nianfen As Integer Dim text1 As String ’存储考号 Dim text2 As String '存储报名序号 Dim text3 As String '存储浏览器地址 Dim fuwuqi As String '存储服务器地址 Dim tijiao As String ’存储提交命令 nianfen = 2025 ’存储年份，每年更改“2025” fuwuqi = ”http://218.28。109.125:81/cjcx/tmp_cx_zzcj。php” ’自行更改为可用服务器 tijiao = ”&cmdok=???" 'cmdok=？？？为提交命令 bb = Sheet3.Range("a65536")。End(xlUp）.Row ’计算当前工作表 sheet3 的有效行数,需自行更改“sheet3” ' On Error Resume Next '主程序 k = 0 For j = 2 To bb ’循环变量从 2 到 sheet2 最后一行,出错后起始值改为当前行 k = k + 1 ’ If k >； 20 Then ’每 20 行,可以增大“20”数值 ActiveWorkbook.Save '自动保存 ActiveWindow.ScrollRow = j ’自动滚屏到当前行 k = 0 '循环变量清零 End If text1 = Cells(j， 1） '从当前行第一列读取考号，根据情况调整列“1"数值 text2 = Cells（j， 2） '从当前行第二列读取报名序号，根据情况调整列“2"数值 '生成查询地址 text3 = fuwuqi &； ”？textdate=” &； nianfen ＆amp; "＆amp；textkh=” ＆amp； text1 ＆amp; ”&；textzjhm=” & text2 & tijiao ’创建网页对象 Set ie = CreateObject（"InternetExplorer。Application”) With ie .Visible = False ’网页设置为不可见 。Navigate text3 ’导航到查询网址并提交 ’On Error Resume Next ’ MsgBox text3 'Sleep 10000 ’sleep 库函数未用 Do Until .ReadyState = 4 '等网页完全打开 DoEvents Loop Set dmt = 。Document '读取查询服务器返回内容 '网页内容处理 i = 0 '循环变量清零 For Each td In dmt。getElementsByTagName_r(”td”） ’查找网页代码内的文本填充到当前行的第 i+5 列，根据要求适当调整 i+5 的值 End If Next .Quit ’关闭网页 Set dmt = Nothing 'DMT 对象清空 End With Next j Set ie = Nothing 'IE 对象清空 ［s2］。CurrentRegion。Columns。AutoFit '设置为自动填充 End Sub i = i + 1 If i ＆gt； 13 Then '第 13 个 TD 后为分数 Cells（j, 5 + i） = td.innerText '每个
