返回列表 上一主題 發帖

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

回復 29# chang0833
回復 28# GBKEE

GBKEE 版大沒留意您在 34. ~ 46. 間加入了        If ~ Then 的判斷語句。歹勢!
  1.     If .ResultRange.Rows.Count = 2 Then '無資料
  2.         D_Name = .Name      'WEB查詢的名稱
  3.         .Delete             '刪除:WEB查詢
  4.         With Rng.Parent
  5.             For Each E In .Names
  6.         If InStr(E.Name, D_Name) Then E.Delete '刪除:工作表上的名稱->WEB查詢的名稱
  7.             Next
  8.         End With
  9.     Else
  10.         With .ResultRange      ''WEB查詢資料的範圍
  11.             Set Rng = .Cells(.Rows.Count + 2, 1)     ' 下一WEB查詢的位置
  12.         End With
  13.     End If
複製代碼

TOP

回復 31# c_c_lai
這網頁有點奇怪,年度的選項為何有下一年度(未來的年度).
有人可分享嗎?
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 c_c_lai 於 2015-11-13 07:55 編輯
回復  c_c_lai
這網頁有點奇怪,年度的選項為何有下一年度(未來的年度).
有人可分享嗎?
GBKEE 發表於 2015-11-13 06:00

下一年度(未來的年度)  民國 105 年尚未到達,理論上它是一個未知數,
會計年度也只到今年度而已,且尚未年度結轉哪來的資料?

TOP

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

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

TOP

本帖最後由 c_c_lai 於 2015-11-15 07:04 編輯

回復 34# chang0833
第一個『應收票據淨額』是『項目』(標題),
第二個『應收票據淨額』是會計『科目』,
兩者在寶表上是有前後位置差異的,
轉入後如不仔細觀察,便以為是
重覆『科目』了。
至於 VLOOKUP 的應用就有勞 GBKEE 版大了。

TOP

本帖最後由 GBKEE 於 2015-11-16 05:28 編輯

回復 34# chang0833
或是附檔 需要哪些資料
  1. Next
  2.     '''加上這段試試看
  3.     With Rng.Parent
  4.          .Range("A:A").SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
  5.          '刪除:工作表上的空白列
  6.     End With
  7.     ''''''''''''''''
  8.     MsgBox "Ok"
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

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

回復 38# chang0833
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim URL As String, xCo_Id As String, X As Integer
  4.     Dim xSyear As Integer, xSseason As Integer, Ar(1 To 4)
  5.     Dim Sh(1 To 2) As Worksheet, AY, Rng As Range, E As Variant
  6.     Dim Wb As Workbook
  7.     For X = 0 To 3
  8.         Ar(X + 1) = 1 + (6 * X)  '第一季到第四季的欄位
  9.     Next
  10.     xCo_Id = Application.InputBox("請輸入股票代號", , 2303)         '預設為 2303
  11.     X = Year(Date) - 1910                 '中華民國的年度
  12.     Application.ScreenUpdating = False
  13.     Set Wb = Workbooks("book1.xls")           '指定活頁簿
  14.     With Wb
  15.         Set Sh(1) = .Sheets.Add               '新增工作表: 複製季財報到指定工作頁
  16.         Set Sh(2) = .Sheets.Add               '新增工作表:  WEB查詢用
  17.     End With
  18.     On Error GoTo Er                        '處理程式上的錯誤
  19.     Sh(1).Name = xCo_Id & "季報表"          '這名稱工作表如已存在程式會有錯誤
  20.     On Error GoTo 0                         '不在處理程式上的錯誤
  21.    
  22.     For xSyear = X To X - 3 Step -1        '迴圈:年度    '105->102
  23.     'For xSyear = X - 3 To X               '迴圈:年度    '102->105
  24.         For xSseason = 1 To 4 '             '迴圈:季別    '1,2,3,4
  25.             URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
  26.             With Sh(2).QueryTables.Add(Connection:=URL, Destination:=Sh(2).[A1])
  27.                 .Name = xCo_Id & "_" & xSyear & "_第" & xSseason & "季" 'WEB查詢的名稱
  28.                 .AdjustColumnWidth = True                  '自動調整欄寬
  29.                 .WebSelectionType = xlSpecifiedTables
  30.                 .WebFormatting = xlWebFormattingNone
  31.                 .WebTables = "2,3,4"                  '資產負債表,綜合損益表,現金流量表
  32.                 .WebPreFormattedTextToColumns = True
  33.                 .WebConsecutiveDelimitersAsOne = True
  34.                 .WebSingleBlockTextImport = False
  35.                 .WebDisableDateRecognition = False
  36.                 .WebDisableRedirections = False
  37.                 .Refresh BackgroundQuery:=False
  38.                 If .ResultRange.Rows.Count > 2 Then '有資料
  39.                     Set Rng = Sh(1).Cells(1, Ar(xSseason)).Cells(Rows.Count).End(xlUp)
  40.                     If Rng.Row > 1 Then Set Rng = Rng.Offset(2)
  41.                     .ResultRange.Copy Rng
  42.                 Else
  43.                     .Delete
  44.                 End If
  45.                
  46.             End With
  47.         Next
  48.     Next
  49.     Application.DisplayAlerts = False
  50.     Sh(2).Delete
  51.     Application.DisplayAlerts = True
  52.     Application.ScreenUpdating = True
  53.     Sh(1).Parent.Save
  54.     MsgBox "Ok"
  55.     Exit Sub
  56. Er:     '處理 xCo_Id &季報表 工作表已存在
  57.     Application.DisplayAlerts = False
  58.     Sheets(xCo_Id & "季報表").Delete
  59.     Application.DisplayAlerts = True
  60.    Resume Next  '回到錯誤的程式碼
  61. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 39# GBKEE


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

TOP

        靜思自在 : 人要自愛,才能愛普天下的人。
返回列表 上一主題