Execl高手如何用VBAexcel vba 提取字符网数

无法找到该页
无法找到该页
您正在搜索的页面可能已经删除、更名或暂时不可用。
请尝试以下操作:
确保浏览器的地址栏中显示的网站地址的拼写和格式正确无误。
如果通过单击链接而到达了该网页,请与网站管理员联系,通知他们该链接的格式不正确。
单击按钮尝试另一个链接。
HTTP 错误 404 - 文件或目录未找到。Internet 信息服务 (IIS)
技术信息(为技术支持人员提供)
转到 并搜索包括&HTTP&和&404&的标题。
打开&IIS 帮助&(可在 IIS 管理器 (inetmgr) 中访问),然后搜索标题为&网站设置&、&常规管理任务&和&关于自定义错误消息&的主题。查看: 326|回复: 0|
在线时间106 小时经验70 威望0 性别男最后登录注册时间阅读权限20UID1837752积分70帖子精华0分享0
EH初级, 积分 70, 距离下一级还需 280 积分
积分排行3000+帖子精华0微积分0
本帖最后由 烟火孤星泪 于
13:45 编辑
1.请高手帮我把网站中pk10的开奖数据获取到excel上,使用按键在线更新,
更新形式,顺序排列
关注我们,与您相约微信公众平台!
Copyright 1999 - 2017 Excel Home. All Rights Reserved.本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!
Powered by
本站特聘法律顾问:徐怀玉律师 李志群律师 &&查看: 3456|回复: 12|
在线时间628 小时经验651 威望0 性别男最后登录注册时间阅读权限30UID64495积分651帖子精华0分享0
EH中级, 积分 651, 距离下一级还需 449 积分
积分排行1659帖子精华0微积分0
本帖最后由 dy_ysl 于
12:28 编辑
因为是报表网页,涉及到保密问题,只能将两个网页的全码文件上传上来,麻烦各位大师给予帮忙
从 11文件 中进取如 ?act=show&ID=20045 ,作为一个变量,以方便打开对应的网页。
从 12文件 中 提取如下 红色 部分及 数值 数据,保存到EXCEL表格的一行中:在此先谢谢各位关注的大师及朋友。
(5.24 KB, 下载次数: 42)
17:21 上传
下载次数: 42
&td height=&25&&界牌镇&/td&
&td&19&/td&
&td&20&/td&
&td&1&/td&
感谢给予关注的各位老师,特别感谢 网页分析工具 制作大师。
在线时间116 小时经验81 威望0 最后登录注册时间阅读权限20UID1446492积分81帖子精华0分享2
EH初级, 积分 81, 距离下一级还需 269 积分
积分排行3000+帖子精华0微积分0
工具-引用 Microsoft VBScript Regular Expressions 5.5
Function Regex(ByVal Body As String, ByVal RegexStr As String) As String()
Dim r As RegExp
Dim mc As MatchCollection
Set r = New RegExp
r.Global = True
r.MultiLine = True
r.Pattern = RegexStr
Set mc = r.Execute(Body)
Dim h As Integer: h = mc.Count - 1
Dim s() As String
ReDim s(h)
For i = 0 To h
s(i) = mc.Item(i)
End Function
Dim Html As String: Html = &Html文本&
For Each s In Regex(Html, &&.*.&&)
Debug.Print s
在线时间628 小时经验651 威望0 性别男最后登录注册时间阅读权限30UID64495积分651帖子精华0分享0
EH中级, 积分 651, 距离下一级还需 449 积分
积分排行1659帖子精华0微积分0
人形电脑天使心 发表于
工具-引用 Microsoft VBScript Regular Expressions 5.5
Function Regex(ByVal Body As String, ByVal R ...
谢谢 的帮助,测试了一下,当运行到ReDim s(h)时出现:运行时错误,下标越界。麻烦再看一下
在线时间628 小时经验651 威望0 性别男最后登录注册时间阅读权限30UID64495积分651帖子精华0分享0
EH中级, 积分 651, 距离下一级还需 449 积分
积分排行1659帖子精华0微积分0
继续求助呵,希望大师们早日出现,不胜感激
在线时间628 小时经验651 威望0 性别男最后登录注册时间阅读权限30UID64495积分651帖子精华0分享0
EH中级, 积分 651, 距离下一级还需 449 积分
积分排行1659帖子精华0微积分0
难道高手都不屑如此小难度的???
在线时间628 小时经验651 威望0 性别男最后登录注册时间阅读权限30UID64495积分651帖子精华0分享0
EH中级, 积分 651, 距离下一级还需 449 积分
积分排行1659帖子精华0微积分0
继续求助呵,希望大师们早日出现,不胜感激
在线时间628 小时经验651 威望0 性别男最后登录注册时间阅读权限30UID64495积分651帖子精华0分享0
EH中级, 积分 651, 距离下一级还需 449 积分
积分排行1659帖子精华0微积分0
本帖最后由 dy_ysl 于
14:11 编辑
对应于文件 11 的,按论坛中各位老师的方式如下
& & With CreateObject(&Msxml2.XMLHTTP&)
& && &&&.Open &GET&, ThisWorkbook.Path & &\11.txt&, False
& && &&&.send
& && &&&While .readystate && 4
& && && && &DoEvents
& && &&&Wend
& && &&&HTML = .responsetext
& &&&For i = 3 To 16
& && &&&s = Split(Split(StrConv(.responsebody, vbUnicode, &H804), &&a href=&)(i), &&/a&&)(0)
& &&&End With
可是得到的结果是 &&?act=show&ID=20045& target=&_blank&&查看&
离目标已经很近了,还望能得到各位老师们的指点。目标值应为: ?act=show&ID=20045
====================================================================
其实真正的目的不是为了找到&&?act=show&ID=20045,而是为了实现 转到子网页:
http://tongji./tab5.php?act=show&ID=20045
能够直接得到,当然最好,所以希望能得到那位大师能够的帮忙。
在线时间116 小时经验81 威望0 最后登录注册时间阅读权限20UID1446492积分81帖子精华0分享2
EH初级, 积分 81, 距离下一级还需 269 积分
积分排行3000+帖子精华0微积分0
本帖最后由 人形电脑天使心 于
18:14 编辑
把文件都放在C盘 打开程序填入正则(?:(?&=&td height=&25&&).*.|(?&=&td&)\d{1,999})(?=&/td&)
之后点Button1读取'实验.xls'就可以了 网页同理
(0 Bytes, 下载次数: 49)
18:12 上传
下载次数: 49
在线时间628 小时经验651 威望0 性别男最后登录注册时间阅读权限30UID64495积分651帖子精华0分享0
EH中级, 积分 651, 距离下一级还需 449 积分
积分排行1659帖子精华0微积分0
很感谢人形电脑天使心老师的指导,因为自己对VBA还不是很熟悉,特别是对网页的操作更是无知。所以目前还没法明白什么正则 原理
不过根据 本论坛的一位高手的 网页分析工具,目前已经解决了第一部分,下面继续 依葫芦画瓢,希望能完成第二部分。代码列出来:
Dim ie1 As Object, dmt As Object, r As Object, i As Long, x As Long, j As Long, ff As Variant
& & Dim htMent As HTMLCommentElement& & '& && & As IHTMLElementCollection
'With CreateObject(&InternetExplorer.Application&)
'.Visible = True
'.navigate &http://tongji./login.php&
'Do Until .readyState = 4
'.document.Forms(0).all(&username&).Value = &******&
'.document.Forms(0).all(&Passwd&).Value = &******&
'.document.Forms(0).all.tags(&input&)(4).Click
Set ie1 = UserForm1.WebBrowser1
.navigate &http://tongji./tab5.php?act=query&code=1&tabtype=& & Sheet1.Range(&b1&) & &&Year=& & Sheet1.Range(&d1&) & &&JiDu=& & Sheet1.Range(&f1&) & &&
Do Until .readyState = 4
& & Set dmt = .document
& & Application.ScreenUpdating = False
'& & Dim Quote As IHTMLElement
& & Set ff = dmt.all.tags(&A&)
& & On Error Resume Next
& & With Sheet2
& && &&&For i = 2 To ff.Length - 3
& && && && &Set htMent = ff(i)
& && && && &qs
& && &&&Next i
& & End With
Set ie1 = Nothing
Set dmt = Nothing
Set r = Nothing
在线时间628 小时经验651 威望0 性别男最后登录注册时间阅读权限30UID64495积分651帖子精华0分享0
EH中级, 积分 651, 距离下一级还需 449 积分
积分排行1659帖子精华0微积分0
只差最后一步了,希望大师来解救:
Option Explicit
Dim ie1 As Object, ie2 As Object, dmt1 As Object, dmt2 As Object, r As Object, i As Long, x As Long, j As Long, arr$
Dim htMent As HTMLCommentElement, ht As HTMLCommentElement, tt As Variant, ff As Variant& &'& && & As IHTMLElementCollection
Set ie1 = UserForm1.WebBrowser1
Set ie2 = UserForm1.WebBrowser2
& & With ie1
& && & '.Visible = True
& && & .navigate &http://tongji./login.php&
& && & Do Until .readyState = 4
& && && & DoEvents
& && & Loop
& && && & .document.Forms(0).all(&username&).Value = &******&
& && && & .document.Forms(0).all(&Passwd&).Value = &******&
& && && & .document.Forms(0).all.tags(&input&)(4).Click
& & End With
'以上是登录到带用户名及密码的网页
& & With ie1
& && & .navigate &http://tongji./tab5.php?act=query&code=1&tabtype=& & Sheet1.Range(&b1&) & &&Year=& & Sheet1.Range(&d1&) & &&JiDu=& & Sheet1.Range(&f1&) & &&
& && & Do Until .readyState = 4
& && && & DoEvents
& && & Loop
& && & Set dmt1 = .document
& && & Application.ScreenUpdating = False
& & '& & Dim Quote As IHTMLElement
& && & Set ff = dmt1.all.tags(&A&)
& && & On Error Resume Next
& &&&End With
& &&&For i = 2 To ff.Length - 3
& && && &Set htMent = ff(i)
‘以上为对应于文本11的网页
& && && && &With ie2
'& && && && &.Visible = True
& && && && && & .navigate htMent
& && && && && & Do Until .readyState = 4
& && && && && && & DoEvents
& && && && && & Loop
& && && && && & Set dmt2 = .document
& && && && && & Application.ScreenUpdating = False
& && && && && & Set r = dmt2.all.tags(&TR&)(12)
& && && && && & On Error Resume Next
& && && &&&End With
& && && &&&j = Sheet2.Range(&A65536&).End(xlUp).Row + 1
& && && &&&Sheet2.Cells(j, 1) = r.innerText
'& && && &&&Sheet2.Cells(2, 3) = r.outerHTML
& &&&Next i
’以上为对应于文本12的网页,并把数据提取存入EXCEL表格中
Set ie1 = Nothing
Set dmt1 = Nothing
Set ie2 = Nothing
Set dmt2 = Nothing
Set r = Nothing
最后结果如下,没有分列,请老师帮助分列
珥陵镇51100
导墅镇6630
延陵镇1390
后巷镇1290
关注我们,与您相约微信公众平台!
Copyright 1999 - 2017 Excel Home. All Rights Reserved.本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!
Powered by
本站特聘法律顾问:徐怀玉律师 李志群律师 &&无法找到该页
无法找到该页
您正在搜索的页面可能已经删除、更名或暂时不可用。
请尝试以下操作:
确保浏览器的地址栏中显示的网站地址的拼写和格式正确无误。
如果通过单击链接而到达了该网页,请与网站管理员联系,通知他们该链接的格式不正确。
单击按钮尝试另一个链接。
HTTP 错误 404 - 文件或目录未找到。Internet 信息服务 (IIS)
技术信息(为技术支持人员提供)
转到 并搜索包括&HTTP&和&404&的标题。
打开&IIS 帮助&(可在 IIS 管理器 (inetmgr) 中访问),然后搜索标题为&网站设置&、&常规管理任务&和&关于自定义错误消息&的主题。

我要回帖

更多关于 vba调用excel函数 的文章

 

随机推荐