select vba 网页 翻页_请高手写个代码：vba按条件打开多网页复制多个页面数据到excel...

展开全部

由于你没有说明是怎么操作a1为1的以及复制网页到剪贴板后怎样整理数32313133353236313431303231363533e59b9ee7ad9431333335333036据(一般都不会直接粘贴的)后再粘贴到单元格或单元格区域以及没有具体的网址等等原因，我提供的代码需要你自行修改。所以只提供了a1的代码，b1、c1、d1代码基本相同，套用就可以了。

由于涉及到系统剪贴板(不是OFFICE剪贴板)操作，必须引用系统对象，所以做了一个【自动引用】的宏，该宏只需率先运行一次，以后就不需要了。Sub FM20自动引用()

'由于涉及到Windows剪贴板操作，该引用是必须的

'如果你是精简版EXCEL则可能没有【FM20.DLL】这个文件

'请到网上下载放到C:\Windows\System32\目录下

'该引用在同一个EXCEL软件下只使用一次

Application.SendKeys "%{F11}" '打开代码窗口

Application.SendKeys "%T" '选择工具标签

Application.SendKeys "R" '打开引用窗口

Application.SendKeys "%B" '打开浏览窗口

Application.SendKeys "FM20.DLL" '键入文件名

Application.SendKeys "%O" '点击打开

Application.SendKeys "{ENTER}" '回车确定

Application.SendKeys "%F" '选择文件标签

Application.SendKeys "C" '返回

End Sub

下面是打开网页复制粘贴的代码：Sub 复制网页()

nm = ThisWorkbook.Name '当前工作簿名称

FM: '起点标签

If Sheet1.Cells(1, 1) = 1 Then '判断a1是否为1

Set ie = CreateObject("InternetExplorer.Application") '设置变量

With ie '设置块

.navigate "

打开网页

Do Until .ReadyState = 4 '等待网页加载完毕

Loop '完毕执行下面语句

.Document.body.Focus '定位

.Document.execCommand "SelectAll" '全选

.Document.execCommand "copy" '复制

End With '块结束

Application.SendKeys "^{F4}" '发送按键关闭当前浏览器标签

Dim R As New DataObject, S '定义变量

R.GetFromClipboard '获取剪贴板到R

Sheet2.Cells(1, 1).Value = R.GetText '粘贴到指定单元格

AppActivate ("Microsoft Excel - " & nm) '返回工作簿

Exit Sub '结束当前宏

End If

GoTo FM 'a1没有为1回到起点循环

End Sub

其中的网址是我随便放进去的，你可以更换成你需要的网址。