Excel VBA抓取股票資料

使用QueryTables方法寫一個簡單的上市櫃股票的所有基本資料。


抓取交易明細完成畫面

VBA程式碼如下

Option Explicit

'股票類別
'01 水泥工業
'02 食品工業
'03 塑膠工業
'04 紡織纖維
'05 電機機械
'06 電器電纜
'07 化學生技醫療
'08 玻璃陶瓷
'09 造紙工業
'10 鋼鐵工業
'11 橡膠工業
'12 汽車工業
'13 電子工業
'14 建材營造
'15 航運業
'16 觀光事業
'17 金融保險業
'18 金融保險業
'19 綜合企業
'20 其他
'21 化學工業
'22 生技醫療業
'23 油電燃氣業
'24 半導體業
'25 電腦及週邊設備業
'26 光電業
'27 通信網路業
'28 電子零組件業
'29 電子通路業
'30 資訊服務業
'31 其他電子業

Dim Tempsheet As Excel.Worksheet

Private Sub 更新股票資料_Click()
    抓取股票基本資料
End Sub

Sub 抓取股票基本資料()
    Dim n As Integer
    Dim StartTime
    
    StartTime = Now

    If 確認工作表存在("Temp") <> True Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
    End If
    
    清除工作表 ("Sheet1")
    清除工作表 ("Temp")
    
    Application.ScreenUpdating = False
    
    Set Tempsheet = Sheets("Temp")
    
    If 取得股票資料 = 0 Then
        MsgBox "無法抓取股票資料"
        Exit Sub
    End If
  
    Application.StatusBar = "正在轉換資料，請稍後......"
    
    With Sheet1
        .Cells(1, 1) = "股票代碼"
        .Cells(1, 2) = "公司名稱"
        
        n = 取得公司間數
        Tempsheet.Range("A1:B" & n).Copy    '目前只列出股票代碼、公司名稱，如有需要其他欄位，請自行變更
    
        .Cells(2, 1).Select
        .Paste
    End With
    
    Application.StatusBar = "股票基本資料抓取完成"
    Application.ScreenUpdating = True
    
    MsgBox "股票基本資料下載 共花費 " & Format(Now - StartTime, "HH時mm分ss秒") & " 下載完成。" & vbCrLf & "以秒計算 共花費 " & DateDiff("s", StartTime, Now) & " 秒下載完成", vbInformation

End Sub

Sub 清除工作表(xlWSName As String)
    Dim qyt As QueryTable
    With Worksheets(xlWSName)
        For Each qyt In .QueryTables
            qyt.Delete
        Next
    
        .Cells.Clear
        .Cells.ClearContents
    End With
End Sub

Function 取得公司間數()
    Dim i As Integer, j As Integer, n As Integer
    j = 0
    取得公司間數 = 0
    With Tempsheet
        n = .Cells(65536, 1).End(xlUp).Row
        For i = 1 To n
            If .Cells(i, 1).Value = Empty Or _
               .Cells(i, 1).Value = "代號" Or _
               .Cells(i, 1).Value = "公司" Then
                j = j + 1
                .Rows(i & ":" & i).Delete Shift:=xlUp
                If n - j >= i Then
                    i = i - 1
                End If
             End If
        Next
        取得公司間數 = .Cells(65536, 1).End(xlUp).Row
    End With
End Function

Function 取得股票資料()
    Dim xlURL As String
    
    Application.StatusBar = "從Web取得股票資料中，請稍後......"
    
    xlURL = "http://mops.twse.com.tw/mops/web/ajax_t51sb01?step=1&firstin=1&TYPEK=sii" '上市 sii, 上櫃 otc
    With Tempsheet.QueryTables.Add("URL;" & xlURL, Tempsheet.Cells(1, 1))
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2"
        .Refresh 0
        If Application.Count(.ResultRange) = 0 Then
            取得股票資料 = 0
            Exit Function
        End If
        取得股票資料 = Application.Count(.ResultRange)
        .Delete
    End With
End Function

Function 確認工作表存在(xlWSName As String) As Boolean
    On Error Resume Next
    Dim xlTemp As Excel.Worksheet
    
    Set xlTemp = Worksheets(xlWSName)
    If Not xlTemp Is Nothing Then
        確認工作表存在 = True
        On Error GoTo 0
        Set xlTemp = Nothing
        Exit Function
    End If
    
    確認工作表存在 = False
    On Error GoTo 0
    Set xlTemp = Nothing
End Function

如果覺得自己寫很麻煩，可至這裡下載