|
本帖最后由 VBA万岁 于 2015-4-17 10:00 编辑
suwenkai 发表于 2014-9-16 22:17
回91楼
另,想请教一下suwenkai大师,我用以下代码将网页中各查询下拉选项的值下载至Excel的各查询下拉选项中了,然后想通过第2段代码将Excel的各查询下拉选项中的值填入网页中的各查询下拉选项,可之后网页并没有自动显示查询结果(手动输入查询值时网页是会自动显示查询结果的)。有什么办法解决这一问题?因为只有网页自动显示了查询结果时,才可以将其导回Excel表。
或者,不用IE法,直接用XMLHTTP获得查询结果更好。
- Sub 更新下拉列表值()
- Dim html, op, arr, brr, i%, j%
- Set html = CreateObject("htmlfile")
- arr = Array("ctl04$sysq", "ctl04$nf", "ctl04$xkml", "ctl04$zymc", "ctl04$pyfs", "ctl04$pyfs")
- ReDim brr(0 To 4)
- With CreateObject("msxml2.xmlhttp")
- .Open "GET", "http://zsw.bjtu.edu.cn/JHFS/Default.aspx", False
- .send
- html.body.innerHTML = .responseText
- 'For Each sl In html.all.tags("select")
- 't = t & sl.Name & ","
- 'Next
- 't = Mid(t, 1, Len(t) - 1)
- 'arr = Split(t, ",")
- For i = 0 To UBound(arr) - 1
- For Each op In html.all.tags("select")(arr(i)).all.tags("option")
- brr(i) = brr(i) & op.Value & ","
- Next
- Next i
- End With
- Range("b1,d1,f1,h1,j1").Validation.Delete
- For j = 0 To 8 Step 2
- Range("b1").Offset(, j).Validation.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=Mid(brr(j / 2), 1, Len(brr(j / 2)) - 1)
- Next j
- Range("j1").Select
- End Sub
- Sub 北京交大招生取数查询()
- Dim shp As Shape, r0 As Long, p%, i%, j%, r, t
- ActiveSheet.UsedRange.Offset(2).Clear
- On Error Resume Next
- arr = Array("ctl04$sysq", "ctl04$nf", "ctl04$xkml", "ctl04$zymc", "ctl04$pyfs", "ctl04$pyfs")
- With CreateObject("internetexplorer.application")
- .Visible = True
- .Navigate "http://zsw.bjtu.edu.cn/JHFS/Default.aspx"
- Do Until .ReadyState = 4
- DoEvents
- Loop
- For i = 0 To UBound(arr) - 1
- .Document.all.tags("select")(arr(i)).Value = Range("b1").Offset(, 2 * i).Value
- Next i
- End With
- End Sub
复制代码
|
|