WebBrowser控件网页数据抓取（II） - EXCEL VBA（23）

为了便于股票数据查询，可查阅上海和深圳证交所股票代码表，网址如下：

上海：http://www.wstock.net/wstock/market/shcode1.htm
 深圳：http://www.wstock.net/wstock/market/szcode1.htm

这两个网页提供了上海和深圳证券交易所股票代码和名称，如图：

两个网页共有220多张表格，每个表格有160个证券代码和名称信息。抓取220×160=35200条证券代码和名称信息，这项任务完全贴近实战，需要较高的EXCEL VBA编程水平。

1、网页结构分析

I、表格结构

用浏览器打开网页后，每张表格中有40×4=160个证券代码和名称。

II、网页分页

上海证券交易所证券代码和名称信息表共有154张表，网址“http://www.wstock.net/wstock/market/shcode1.htm”中“shcode1.htm”代表第1张表、“shcode2.htm”代表第2张表、...、“shcode154.htm”代表第154张表。

深圳证券交易所证券代码和名称信息表共有75张表，网址“http://www.wstock.net/wstock/market/szcode1.htm”中“szcode1.htm”代表第1张表、“szcode2.htm”代表第2张表、...、“szcode75.htm”代表第75张表。

III、股票代码筛选

上述两个网址提供的证券代码和名称有股票、有证券和债券，有上市的股票和未上市的股票、有A股和B股。我们的目的是只抓取沪深两市场的上市交易股票。

上证股票A股代码为“6”字头。深圳证券交易所“000”开头为主板、“3”字头为创业板、“002”开头为中小板。代码具备这些开头特征的股票代码是我们抓取的目标。

IV、分页范围

通过翻页观察，上海证券交易所“6”字头股票代码和名称信息表在2-17页；深圳证券交易所“000”开头、“3”字头、“002”开头股票代码和名称信息表在1-14页。两市我们要抓取的数据都在1-20页内。

2、表格信息抓取窗体

I、建立窗体如下图

窗体控件解释：

CommandButton1：【打开网页】命令按钮；
CommandButton2：【网页数据抓取】命令按钮；
TextBox1：网址文本框（单行）
WebBrowser1：网页控件

II、打开Web页面

打开窗体时运用CommandButton1【打开网页】命令按钮打开TextBox1网址文本框中指定的网页

Private Sub CommandButton1_Click()
WebBrowser1.Navigate TextBox1.Text
End Sub

由于浏览器兼容问题和网页制作者的疏忽，打开网页时往往会弹出上面警告窗口，屏蔽脚本错误的方法如下：

Private Sub CommandButton1_Click()
'打开网页时屏蔽脚本错误
WebBrowser1.Silent = True
WebBrowser1.Navigate TextBox1.Text
End Sub

3、解析HTML文档

I、通过table标签集合抓取表格数据

网页中要抓取的标签没设定id属性，可通过DOM文档模型的Document.getElementsByTagName获得table标签集合。将CommandButton2【网页数据抓取】命令按钮做为人机对话代码调试按，查找表格集合序号代码如下：

Private Sub CommandButton2_Click()
Dim tables As Object
Dim i, k As Integer
Dim tbRows As Integer
' 获取网文档中所有的table集合
Set tables = WebBrowser1.Document.getElementsByTagName("table")
' 获取网页文档中table标签数量
k = tables.Length
For i = 0 To k - 1
    Set doc = tables(i)
    tbRows = doc.Rows.Length
    If tbRows > 40 Then
        MsgBox i
        Exit For
    End If
Next i
End Sub

运行窗体，用CommandButton1【打开网页】命令按钮打开TextBox1文本框网址，显示窗体如下，

点击CommandButton2【网页数据抓取】命令按钮，

说明要查找表格集合序号为20。表格集合序号从0开始，说明第21个表格是我们要抓取的表格。

II、表格数据抓取

更换CommandButton2【网页数据抓取】命令按钮代码：

Dim tables As Object
' 获取文档中所有的table集合
Set tables = WebBrowser1.Document.getElementsByTagName("table")
' 获取文档中第21个table对象
Set doc = tables(20)
Dim tbRows As Integer
Dim tbCols As Integer
Dim i, j As Integer
tbRows = doc.Rows.Length
tbCols = doc.Rows(0).Cells.Length
Sheet1.Cells.Clear
'不需要表格最后一行
For i = 0 To tbRows - 2
    For j = 0 To tbCols - 1
        Sheet1.Cells(i + 1, j + 1) = doc.Rows(i).Cells(j).innerText
    Next j
Next i
End Sub

运行代码，上交所股票代码和名称网址（http://www.wstock.net/wstock/market/shcode2.htm）第2页（shcode2.htm）第21个表格部分数据（全部数据到41行）被写入EXCEL文档sheet1表中。如图，

如前所述，上海证券交易所“6”字头股票代码和名称信息表在2-17页，深圳证券交易所“000”开头、“3”字头、“002”开头股票代码和名称信息表在1-13页。

替换TextBox1文本框网址：

'替换shcodeN.htm的分页序号N，N=2,3, ..., 16
上海：http://www.wstock.net/wstock/market/shcode2~16.htm
'替换szcodeN.htm的分页序号N，N=1,2, ..., 13
深圳：http://www.wstock.net/wstock/market/szcode1~13.htm

每次替换网址分页序号后，执行【打开网页】、【网页数据抓取】，

反复进行如下操作：

替换网址分页序号
执行【打开网页】
执行【网页数据抓取】
复制、粘贴sheet1表中数据到其它表格

至此，如果信息更新不太频繁、网页分页不多情况下，数据抓取任务就算基本完成了，剩下的工作可以在EXCEL前端完成。

4、数据处理

通常，在网上抓取的信息在格式、内容上不符合我们的要求，需要按要求进行进一步处理。另外，如果抓取信息分页过多、更新频繁，则需要进一步提高数据抓取效率。

I、改进数据抓取流程

在原来窗口添加一个命令按钮和文本框，窗体如下：

CommandButton3：【上证分页数据抓取】命令按钮；
CommandButton4：【深证分页数据抓取】命令按钮
TextBox3：分页序号文本框（单行）

添加UserForm_Initialize窗体初始化事件代码，

Private Sub UserForm_Initialize()
Sheet1.Cells.Clear
Sheet2.Cells.Clear
Sheet3.Cells.Clear
End Sub

每次运行窗体，Sheet1、Sheet3、Sheet3表格数据被清空。结果显示如下：

抓取上证数据时，CommandButton3【上证分页数据抓取】命令按钮代码如下：

Private Sub CommandButton3_Click()
'上证数据对应shcode
TextBox1.Text = "http://www.wstock.net/wstock/market/shcode" & TextBox2.Text & ".htm"
Call CommandButton1_Click
TextBox2.Text = TextBox2.Value + 1
End Sub

连续点击CommandButton3【上证分页数据抓取】命令按钮，每次点击【序号】自动增加1，从而实现分页数据抓取。

同理，抓取深证数据时，CommandButton4【深证分页数据抓取】命令按钮代码如下：

Private Sub CommandButton4_Click()
'深证数据对应szcode
TextBox1.Text = "http://www.wstock.net/wstock/market/szcode" & TextBox2.Text & ".htm"
Call CommandButton1_Click
TextBox2.Text = TextBox2.Value + 1
End Sub

连续点击CommandButton4【深证分页数据抓取】命令按钮，每次点击【序号】自动增加1，从而实现分页数据抓取。

每次打开不同分页时，网页加载成功后执行WebBrowser1的DocumentComplete事件，代码如下：

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Call CommandButton2_Click
End Sub

即，连续点击【上证分页数据抓取】命令按钮或【深证分页数据抓取】命令按钮，每次网页加载成功后调用CommandButton2_Click【网页数据抓取】命令按钮。

II、数据筛选

第一步：改进CommandButton2_Click【网页数据抓取】命令按钮代码

Private Sub CommandButton2_Click()
Dim tables As Object
Dim tbRows As Integer
Dim tbCols As Integer
Dim i, j As Integer
Dim city As String
' 获取文档中所有的table集合
Set tables = WebBrowser1.Document.getElementsByTagName("table")
' 获取文档中第21个table对象
Set doc = tables(20)
tbRows = doc.Rows.Length
tbCols = doc.Rows(0).Cells.Length
Sheet1.Cells.Clear
'获取交易所标识符sh或sz
city = Mid(TextBox1.Text, 37, 2)
'不需要表格最后一行
For i = 0 To tbRows - 2
    For j = 0 To tbCols - 1
        If i = 0 Or j / 2 <> Int(j / 2) Then
            Sheet1.Cells(i + 1, j + 1) = doc.Rows(i).Cells(j).innerText
        Else
            '保证股票代码为6位数，并在代码获取交易所标识符sh或sz
            Sheet1.Cells(i + 1, j + 1) = city & Format(Val(doc.Rows(i).Cells(j).innerText), "000000")
        End If
     Next j
Next i
'调用模块子过程setData
Call setData
End Sub

【网页数据抓取】命令按钮代码经过改进后，在窗体上连续点击【上证分页数据抓取】命令按钮或【深证分页数据抓取】命令按钮。每次点击网页表格数据被抓取到sheet1，然后调用模块子过程setData()将数据按2列写入sheet2。setData()代码如下：

Sub setData()
Dim rowCount1, rowCount2 As Long
Dim i, j, k As Long
'获取Sheet1的数据行数
rowCount1 = Sheets("Sheet1").UsedRange.Rows.Count
rowCount2 = Sheets("Sheet2").UsedRange.Rows.Count
For i = 2 To rowCount1
  For j = 1 To 8 Step 2
    If rowCount2 < 2 Then
      Sheets("Sheet2").Cells(1, 1) = "股票代码"
      Sheets("Sheet2").Cells(1, 2) = "股票名称"
      k = Sheets("Sheet2").UsedRange.Rows.Count
      Sheets("Sheet2").Cells(k + 1, 1) = Sheets("Sheet1").Cells(i, j)
      Sheets("Sheet2").Cells(k + 1, 2) = Sheets("Sheet1").Cells(i, j + 1)
    Else
      k = Sheets("Sheet2").UsedRange.Rows.Count
      Sheets("Sheet2").Cells(k + 1, 1) = Sheets("Sheet1").Cells(i, j)
      Sheets("Sheet2").Cells(k + 1, 2) = Sheets("Sheet1").Cells(i, j + 1)
    End If
  Next j
Next i
End Sub

注意，模块子过程setData代码放在【模块1】中，如图，

在窗体上连续点击【上证分页数据抓取】命令按钮，如图，

每次点击，随着序号的变化、页面不断更新，页面表格信息被更新写入sheet1中，如图：

然后调用模块子过程setData()将数据按2列写入sheet2，如图：

注意，在上述过程中，sheet1不断更新、sheet2将sheet1中多列变2列累计写入。对于上证数据来说，按节奏连续点击150次【上证分页数据抓取】命令按钮，150个分页表格的数据被写入sheet1。由于上证和深证的股票代码大致都在1-20页间，分别连续点击20次即可。

最后，再给窗体添加CommandButton5_Click【数据筛选】命令按钮，如图：

CommandButton5_Click【数据筛选】命令按钮，代码如下：

Private Sub CommandButton5_Click()
Dim rowCount As Long
Dim i, k As Long
Dim city As String
Dim a, b, c, d As String
'获取Sheet2的数据行数
rowCount = Sheets("Sheet2").UsedRange.Rows.Count
'获取交易所标识符sh或sz
city = Mid(TextBox1.Text, 37, 2)
Sheet3.Cells(1, 1) = Sheet2.Cells(1, 1)
Sheet3.Cells(1, 2) = Sheet2.Cells(1, 2)
For i = 2 To rowCount
  k = Sheets("Sheet3").UsedRange.Rows.Count
  a = Sheet2.Cells(i, 1)
  b = Sheet2.Cells(i, 2)
  If city = "sh" Then
    If Left(a, 3) = "sh6" And Left(b, 2) <> "退市" Then
      Sheet3.Cells(k + 1, 1) = a
      Sheet3.Cells(k + 1, 2) = b
    End If
  Else
    If Left(a, 3) = "sz3" Or Left(a, 5) = "sz002" Or Left(a, 5) = "sz000" Then
      Sheet3.Cells(k + 1, 1) = a
      Sheet3.Cells(k + 1, 2) = b
    End If
  End If
Next i
End Sub

通过在窗体上连续点击【上证分页数据抓取】命令按钮20次后，点击CommandButton5_Click【数据筛选】命令按钮，经过筛选的数据被写入sheet3。如图：

我们还可以继续改进代码，实现一键完成数据抓取全过程。Web API接口技术可以更高效地数据抓取网页数据，对数据量大、自动化程度要求高的项目，应该选用Web API接口技术。

通过WebBrowser控件抓取网页数据不用过分最求过程自动化，面对灵活多变的网页文档，做到兼容性强、代码易修改即可。

参考文章：

Web Browser控件与网页互动 - EXCEL VBA（21）
WebBrowser控件网页数据抓取（I） - EXCEL VBA（22）

WebBrowser控件网页数据抓取（II） - EXCEL VBA（23）

继续阅读

重塑教育与学习方式：ClonBrowser与Web 3.0时代的可能性

jsoup获取html页面中的内容

如何系统学习EXCEL，想一步一步来。求真话，不要营销。

OFF-WHITEOutOfOffice低帮系带时尚板鞋街头运动元素双色设计标志性Arrows图案标志性ZipTie束线

美剧《越狱》精彩片段。而打电话的人正是吉姆。thinkingburrows，yourman'sdead，justlike

Excel 双斜线表头绘制

UiBot无法抓取Google Chrome元素和数据抓取工具无法使用的解决方案

Excel应用技巧之“日期文本转换为日期格式”1、选择需要设置的EXCEL表格中的单元格。2、在“数据”工具中点击“分列

php 网页数据抓取简单实例

虫师带你入门Chrome Headless，从此爬虫0门槛！爬虫终结者 Chrome Headless总结相关资料

EXCEL VBA 自定义函数招标代理费计算

经验贴，九个实用的EXCEL技巧！#高效办公小技能##图表使用规范##爆料#

每天学习一点点-EXCEL-SUM函数和AVERAGE函数

别被调查汇总郁闷到——有Excel呢！

【工作笔记0006】C#调用HtmlAgilityPack类库实现网页数据抓取

Excel VBA下调用exe的方法