ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 4916|回复: 8

[求助] 求助大神!批量从多个网页导入数据

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-8-15 10:04 | 显示全部楼层 |阅读模式
本帖最后由 coze 于 2018-8-15 10:28 编辑

从论坛试了好多代码都不成功,还请大神赐教!情况如下图:

找到情况最相似的代码如下,但修改半天也没法用于这个网站:http://hs.bianmachaxun.com/query/code.php?word=0101请大神解疑如何修改。。。。

  1. Sub test()
  2.     arr = Sheets("sheet1").Range("a1").CurrentRegion
  3.     Set d = CreateObject("scripting.dictionary")
  4.     For i = 1 To UBound(arr)
  5.         d(arr(i, 1)) = ""
  6.     Next
  7.     Set oDom = CreateObject("htmlfile")
  8.     Set oWindow = oDom.parentWindow
  9.     Set oHttp = CreateObject("msxml2.xmlhttp")
  10.     For Each k In d.keys
  11.         oHttp.Open "GET", k, False
  12.         oHttp.send
  13.         oDom.body.innerHtml = oHttp.responseText
  14.         stext = Replace(oDom.getElementById("p1").innerHtml, "<INPUT", "<span")
  15.         oWindow.clipBoardData.setData "text", stext
  16.         sheets("sheet2").Activate
  17.         Sheets("sheet2").Range("a65536").End(xlUp).Offset(1).Select
  18.         Sheets("sheet2").Paste
  19.     Next
  20. End Sub
复制代码



1.png

批量从多个网页导入数据.rar

19.75 KB, 下载次数: 98

TA的精华主题

TA的得分主题

发表于 2018-8-15 19:02 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
  1. Sub 提取a()
  2. Dim arr()
  3. On Error Resume Next
  4. Cells.Clear
  5.         With CreateObject("msxml2.xmlhttp")
  6.                 For k = 1 To Sheet1.Range("a" & Rows.Count).End(3).Row
  7.                         Url = Sheet1.Cells(k, 1).Value
  8.                         .Open "GET", Url, False
  9.                         .send
  10.                         StrText = .responsetext
  11.                                 With CreateObject("htmlfile")
  12.                                         .write StrText
  13.                                         i = 0
  14.                                                 For Each tr In .all.tags("table")(0).Rows
  15.                                                         i = i + 1
  16.                                                         j = 0
  17.                                                 ReDim Preserve arr(1 To 10, 1 To i)
  18.                                                                 For Each td In tr.Cells
  19.                                                                         j = j + 1
  20.                                                                         arr(j, i) = Replace(td.innertext, " ", "")
  21.                                                                 Next
  22.                                                 Next
  23.                                 End With
  24.                             m = Sheet2.Range("a" & Rows.Count).End(3).Row
  25.                         Range("a" & m, "a" & m + i).NumberFormatLocal = "@"
  26.                         Cells(m + 1, 1).Resize(i, 10).Value = Application.Transpose(arr)
  27.                 Next k
  28.         End With
  29. End Sub
复制代码

评分

3

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-8-15 12:23 | 显示全部楼层
顶一下                  

TA的精华主题

TA的得分主题

发表于 2018-8-15 12:25 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-8-15 16:12 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-8-15 19:38 | 显示全部楼层
请参考>>>>>>>>>>

批量从多个网页导入数据.rar

1.76 MB, 下载次数: 1817

评分

2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-8-15 20:07 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

感谢大神!!!!!!!非常非常感谢!!!

TA的精华主题

TA的得分主题

发表于 2020-3-4 20:41 | 显示全部楼层
ammyc大神的这个代码完美的解决了我目前遇到的问题,向你学习。

TA的精华主题

TA的得分主题

发表于 2020-5-4 21:51 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

大神。。。这个代码为什么只能获取 一个网页里面的一个表格信息。。如何改 ,,求助
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-28 23:15 , Processed in 0.054851 second(s), 17 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表