EXCEL 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