|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub 提取a()
- Dim arr()
- On Error Resume Next
- Cells.Clear
- With CreateObject("msxml2.xmlhttp")
- For k = 1 To Sheet1.Range("a" & Rows.Count).End(3).Row
- Url = Sheet1.Cells(k, 1).Value
- .Open "GET", Url, False
- .send
- StrText = .responsetext
- With CreateObject("htmlfile")
- .write StrText
- i = 0
- For Each tr In .all.tags("table")(0).Rows
- i = i + 1
- j = 0
- ReDim Preserve arr(1 To 10, 1 To i)
- For Each td In tr.Cells
- j = j + 1
- arr(j, i) = Replace(td.innertext, " ", "")
- Next
- Next
- End With
- m = Sheet2.Range("a" & Rows.Count).End(3).Row
- Range("a" & m, "a" & m + i).NumberFormatLocal = "@"
- Cells(m + 1, 1).Resize(i, 10).Value = Application.Transpose(arr)
- Next k
- End With
- End Sub
复制代码 |
评分
-
3
查看全部评分
-
|