|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
借代码修改了一下,功能不少,代码精减了不少,具体如下:
- Private Sub CommandButton1_Click() 'FromSuper
- t = Time
- Application.Goto Sheet1.Range("A1")
- If OptionButton1.Value = True Then Down 1
- If OptionButton2.Value = True Then Down 2
- If OptionButton3.Value = True Then Down 3
- If OptionButton4.Value = True Then Down 4
- MsgBox "单词网络撷取结束,共耗时: " & Format(Time - t, "h时mm分ss秒")
- End Sub
复制代码- Option Explicit
- Sub Down(p As Integer)
- On Error Resume Next
- Dim html As New HTMLDocument, i, url, w
- With CreateObject("Microsoft.XMLHTTP")
- For i = 2 To Sheet1.Range("A1").CurrentRegion.Rows.Count
- w = Sheet1.Cells(i, 1).Value
- url = IIf(p = 1, "http://dict.youdao.com/search?q=" & w & "&keyfrom=dict.index", IIf(p = 2, "http://dict.baidu.com/s?wd=" & w, IIf(p = 3, "http://cn.bing.com/dict/search?q=" & w & "&go=%E6%8F%90%E4%BA%A4&qs=bs&form=CM", "http://www.iciba.com/" & w)))
- Debug.Print url
- .Open "get", url, True
- .send
- While .readyState <> 4
- DoEvents
- Wend
- html.body.innerHTML = .responseText
- Select Case p
- Case 1 '有道
- Sheet1.Cells(i, 2) = html.getElementsByClassName("baav")(0).innerText
- Sheet1.Cells(i, 3) = html.getElementsByClassName("trans-container")(0).innerText
- Case 2 '百度
- Sheet1.Cells(i, 2) = Replace(html.getElementById("pronounce").innerText, w, "")
- Sheet1.Cells(i, 3) = Replace(html.getElementsByClassName("tab-content")(0).innerText, Chr(10) & "以下结果由 金山词霸 提供", "")
- Case 3 '必应
- Sheet1.Cells(i, 2) = html.getElementsByClassName("hd_p1_1")(0).innerText
- Sheet1.Cells(i, 3) = html.getElementsByTagName("ul")(1).innerText
- Case Else '爱词霸
- Sheet1.Cells(i, 2) = html.getElementsByClassName("prons")(0).innerText
- Sheet1.Cells(i, 3) = html.getElementsByClassName("group_pos")(0).innerText
- End Select
- Sheet1.Cells(1, 6).Value = i - 1 & "/" & Sheet1.Range("A1").CurrentRegion.Rows.Count - 1
- Next
- End With
- End Sub
复制代码
|
评分
-
5
查看全部评分
-
|