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的方法