EXCEL VBA网抓技巧- 利用剪贴板带格式整体复制网页表格数据

2017年2月24日12:24:33 评论 8,855 views
表格 定制  数据 合并 处理 分析 VBA 编程 开发 网页
表格 定制  数据 合并 处理 分析 VBA 编程 开发 网页

在网抓的时候 大部分情况都是抓取表格数据到页面 如果表格规整 循环遍历页代码还好写如果遇到有合并单元格 或者需要保留表格原格式 写代码就显得很麻烦
有一次正好是客户要求保留原格式 我开始也是遍历读取
写到一半突然想起来我们平时不是经常从网页复制粘贴表格到excle么
于是我就尝试代码复制htmldocument对象的表格到excel里粘贴 没想到还真可以
进而再一步实验 只要获取了源码 复制源码中table标签内的字表格字符串
那么粘贴后即可完整保持原来表格格式个样式
测试表及代码如下
测试网页http://www.taifex.com.tw/chinese/3/7_8.asp
需要获得表格截图如下

可以看到这个表格有很多合并单元格排版 还有颜色 
采用剪贴板复制法  我们可以很方便的将整表放入
导出结果如下如 格式完美复制 不用遍历 操作简单方便

代码如下

Option Explicit
'Excel880.COM出品
Public Sub tableTest()
    Dim txt, web
    Set web = CreateObject("MSXML2.XMLHTTP")
    web.Open "Get", "http://www.taifex.com.tw/chinese/3/7_8.asp", False
    web.send
    txt = web.responsetext
    txt = "<table>" & HtmlFilter(txt, "table_f"">", "</table>")
    PutClipboard txt
    Cells.Clear
    [A1].Select
    ActiveSheet.Paste
End Sub
Public Function HtmlFilter(ByVal htmlText$, Label1$, label2$)
'返回html字符串lable1和最近的lable2标签中的数据
    Dim pStart As Long, pStop As Long
    '开始位置,结束位置
    pStart = InStr(htmlText, Label1) + Len(Label1)
    '找到标签信息的起始位置
    If pStart <> 0 Then
        pStop = InStr(pStart, htmlText, label2)
        HtmlFilter = Mid(htmlText, pStart, pStop - pStart)
    End If
End Function
Public Sub PutClipboard(ByVal tt$) 'tt放入剪贴板
    With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")       '调试用,数据放入剪贴板
        .SetText tt
        .PutInClipboard
    End With
End Sub

  • 郑广学老师微信号
  • EXCEL880B
  • weinxin
  • 我的微信公众号
  • EXCEL880
  • weinxin
表格 定制  数据 合并 处理 分析 VBA 编程 开发 网页
表格 定制  数据 合并 处理 分析 VBA 编程 开发 网页

发表评论

您必须才能发表评论!