展开全部
由于你没有说明是怎么操作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
其中的网址是我随便放进去的,你可以更换成你需要的网址。