Excel VBA抓取股票代碼

使用QueryTables方法寫一個簡單的抓取上市櫃股票代碼，有興趣的可以參考。


抓取股票代碼完成畫面

VBA程式碼如下

Option Explicit

Dim Tempsheet As Excel.Worksheet
Private Sub 股票代碼_Click()
    抓取股票代碼
End Sub

Sub 抓取股票代碼()
    Dim StartTime
    
    StartTime = Now

    If 確認工作表存在("Temp") <> True Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
    End If
    清除工作表 ("Temp")
    清除工作表 ("Sheet1")
    
    Set Tempsheet = Sheets("Temp")
    
    Application.ScreenUpdating = False
    
    抓股票代碼
    解析股票代碼
    Application.ScreenUpdating = True
    
    MsgBox "股票代碼資料下載 共花費 " & Format(Now - StartTime, "HH時mm分ss秒") & " 下載完成。" & vbCrLf & "以秒計算 共花費 " & DateDiff("s", StartTime, Now) & " 秒下載完成", vbInformation
End Sub

Sub 解析股票代碼()
    Dim i As Integer, n As Integer
    With Sheet1
        .Cells(1, 1) = "股票代碼"
        .Cells(1, 2) = "公司名稱"
        n = 2
        With Tempsheet
            For i = 2 To .Cells(65536, 6).End(xlUp).Row
                If Trim(.Cells(i, 6)) = "ESVUFR" Or _
                   Trim(.Cells(i, 6)) = "EUOMSR" Or _
                   Trim(.Cells(i, 6)) = "EMXXXA" Or _
                   Trim(.Cells(i, 6)) = "ESVUFA" Then
                   
                    Sheet1.Cells(n, 1) = Split(.Cells(i, 1), "  ")(0)
                    Sheet1.Cells(n, 2) = Split(.Cells(i, 1), "  ")(1)
                    n = n + 1
                End If
            Next i
        End With
   End With
End Sub

Sub 抓股票代碼()
    With Tempsheet.QueryTables.Add("URL;http://isin.twse.com.tw/isin/C_public.jsp?strMode=4", Tempsheet.Cells(1, 1)) 'strMode=2 上市  strMode=4 上櫃
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2"
        .Refresh 0
        If Err.Number <> 0 Then Err.Clear: MsgBox "資料查詢失敗"    '被免資料抓取不成功,而顯示訊息
        .Delete
    End With
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 確認工作表存在(strWSName As String) As Boolean
    Dim Temp As Excel.Worksheet
    
    On Error Resume Next
    Set Temp = Worksheets(strWSName)
    If Not Temp Is Nothing Then
        確認工作表存在 = True
        On Error GoTo 0
        Set Temp = Nothing
        Exit Function
    End If
    
    確認工作表存在 = False
    On Error GoTo 0
    Set Temp = Nothing
End Function

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