返回列表 上一主題 發帖

新版股市公開資訊觀測站的資料抓到EXECL?

回復 8# GBKEE
版大這個程式真的很好用,
我是EXCEL VBA初學者,還在模索階段…痛苦學習中
可以懇請版大在大力幫忙一下,如何能一次下載最新8季的資料及在開頭列出股名或代號
感激不盡,謝謝

TOP

回復 21# chang0833
請問版大,我用最笨的方式複製了八次程式(固定年度及季別),總於可以跑出來了,可是"股票代號"可否設計一個可以自用調整的變數來輸入
"xCo_Id = "K"                   '要求輸入網頁的參數:股票代號"……這一行該如何寫,或者有其它更好的方式。

煩請版大賜教了,感激不盡,謝謝。

Dim URL As String, xCo_Id As String, xSyear As String, xSseason As String

xCo_Id = "K"                   '要求輸入網頁的參數:股票代號
xSyear = "102"    'Format(Date, "e")->中華民國的年度
xSseason = "2"       'Format(Date, "q")->當年度的季別
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
    With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("A1"))
        .AdjustColumnWidth = True                  '自動調整欄寬
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2,3,4"                 '資產負債表,綜合損益表,現金流量表
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

TOP

回復 22# chang0833
感謝版大,代號輸入問題已經解決^^
再請版大解決一個問題,要如何使下載下來的資料,放在指定的儲存格位置??
煩請賜教了,謝謝^^

TOP

版大:我執行後,網頁資料都是從第一列開始排列,在執行到下一季時會把資料往右推
,但遇到財報第四季時,因其格式與其他三季不同,導致更新資料起始不同而改變資料位置
,所以我需要把每一季的下載位置,都放在固定儲存位置,資料才不會每次都不一樣
在勞煩版大了^^謝謝

Dim URL As String, xCo_Id As String, xSyear As String, xSseason As String

K = Application.InputBox("請輸入股票代號")
X = Application.InputBox("請輸入最新年度")
Y = X - 1
Z = X - 2

xCo_Id = "" & K                 '要求輸入網頁的參數:股票代號
xSyear = "" & Z    'Format(Date, "e")->中華民國的年度
xSseason = "2"       'Format(Date, "q")->當年度的季別
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
    With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("A1"))
        .AdjustColumnWidth = True                  '自動調整欄寬
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2,3,4"                 '資產負債表,綜合損益表,現金流量表
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
xCo_Id = "" & K                     '要求輸入網頁的參數:股票代號
xSyear = "" & Z    'Format(Date, "e")->中華民國的年度
xSseason = "3"       'Format(Date, "q")->當年度的季別
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
    With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("A1"))
        .AdjustColumnWidth = True                  '自動調整欄寬
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2,3,4"                 '資產負債表,綜合損益表,現金流量表
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
xCo_Id = "" & K                     '要求輸入網頁的參數:股票代號
xSyear = "" & Z 'Format(Date, "e")->中華民國的年度
xSseason = "4"       'Format(Date, "q")->當年度的季別
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
    With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("A1"))
        .AdjustColumnWidth = True                  '自動調整欄寬
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2,3,4"                 '資產負債表,綜合損益表,現金流量表
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
xCo_Id = "" & K                     '要求輸入網頁的參數:股票代號
xSyear = "" & Y    'Format(Date, "e")->中華民國的年度
xSseason = "1"       'Format(Date, "q")->當年度的季別
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
    With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("A1"))
        .AdjustColumnWidth = True                  '自動調整欄寬
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2,3,4"                 '資產負債表,綜合損益表,現金流量表
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

TOP

回復 26# GBKEE
感謝版大的熱心回復,減輕很多學習上的困擾^^
再請教一下版大所寫的這段程式,只能將輸入最新的年度往前查前二年的資料
,但今年的資料會無法查詢,該如何讓今年的資料也可以下載,
在勞煩版大了,謝謝^^


    For Each xSseason In Array(2, 3, 4, 1) '迴圈xSseason => 2, 3, 4, 1

        xSyear = "" & IIf(xSseason > 1, X - 2, X - 1)

TOP

回復 28# GBKEE

感謝版大,目前下載沒問題了,謝謝^^
目前先來慢慢研究版大的程式,太感恩了^^

TOP

版大,可以在請教一下關於這個財報網頁下載下來的資料問題嗎?
我用vlookup 來比對資料,卻發現下列資料有重複,vlookup 只能捉到第一筆資料,
但是第一筆資料是空白的,要如何捉到重複資料但又可以選擇其後有資料的欄位捉取
再麻煩版大賜教了^^

     應收票據淨額       
     應收票據淨額        72,036
     應收帳款淨額       
     應收帳款淨額        19,452,028
     應收帳款-關係人淨額       
     應收帳款-關係人淨額        231,367

TOP

回復 35# c_c_lai
感謝大大的回復,我懂了,原來差異就在前面空格的排列順序了,不仔細看真的看不出來^^
另外感謝GBKEE版大的用心回復謝謝^^

TOP

回復 36# GBKEE
版大,我將你的程式,改成各季財報橫放,但要如何複製各季財報到其他工作頁時,可以"指定"儲存格存放
比如第一季財報複製其他工作表到a到d欄,第二季複製到g欄到j欄存放      -----(   採固定4欄的格式存放)
我本來想說用IF跑迴圈的程式如讀取到第一列有"會計項目"時,則選取第1到第4欄複製到其它工作表的指定位置
讀取到第二個"會計項目"時,複製到下的個指定的工作表上...
不過對新手的我來說還是很難做到,再煩請版大賜教了,謝謝^^

Dim URL As String, xCo_Id As String, x As Integer, Rng As Range
    Dim E As Variant, xSyear As Integer, xSseason As Integer, D_Name As String
    Dim Ia As Integer
    With ActiveSheet
        For Each E In .QueryTables 'WEB查詢物件集合
            E.Delete
        Next
        For Each E In .Names       'Name 物件的集合
            .Names(E.Name).Delete
        Next
        .UsedRange.Clear
        Set Rng = .Range("a1") '指定工作表上 WEB查詢的位置
    End With
    xCo_Id = Application.InputBox("請輸入股票代號", , 2303)         '預設為 2303
    x = Year(Date) - 1910                  '中華民國的年度
    For xSyear = x To x - 3 Step -1        '迴圈:年度    '105->102
    'For xSyear = X - 3 To X               '迴圈:年度    '102->105
        For xSseason = 4 To 1 Step -1 '             '迴圈:季別    '1,2,3,4
            URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
            With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Rng)
                .Name = xCo_Id & "_" & xSyear & "_第" & xSseason & "季" 'WEB查詢的名稱
                .AdjustColumnWidth = True                  '自動調整欄寬
                .WebSelectionType = xlSpecifiedTables
                .WebFormatting = xlWebFormattingNone
                .WebTables = "2,3,4"                  '資產負債表,綜合損益表,現金流量表
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
                If .ResultRange.Rows.Count = 2 Then '無資料
                    D_Name = .Name                  'WEB查詢的名稱
                    .Delete                         '刪除:WEB查詢
                    With Rng.Parent
                        For Each E In .Names
                            If InStr(E.Name, D_Name) Then E.Delete '刪除:工作表上的名稱->WEB查詢的名稱
                        Next
                    End With
                Else
                    With .ResultRange      'WEB查詢資料的範圍
                        Set Rng = .Cells(1, .Columns.Count + 2) '下一WEB查詢的位置
                    End With
                End If
            End With
        Next
    Next
   
Dim Ba As Integer                                '因讀取到還未發佈的財報,會留空白欄
                                                 '判斷前50欄是否有空白欄,有則刪除
For Ba = 1 To 50
   If Range("A" & Ba).Value = "" Then
      Selection.EntireColumn.Delete
      Else
   End If
Next
   
End Sub

TOP

回復 39# GBKEE


    感謝版大的熱心回復^^
    版大這次寫的程式,對新手的我有點....困難
    我試著跑程式....但跑出"陣列索引超出範圍"...這是什麼情形

TOP

        靜思自在 : 謊言像一朵盛開的鮮花,外表美麗,生命短暫。
返回列表 上一主題