返回列表 上一主題 發帖

[發問] 請問有什麼方法可以在excel上自動更新目前所有上市櫃股票收盤價

本帖最後由 GBKEE 於 2011-7-13 13:27 編輯

回復 12# peter460191
你的問題已在 http://forum.twbts.com/thread-3704-1-1.html 討論過
我的能力只能幫你匯入文字

TOP

回復 13# GBKEE


    非常謝謝GBKEE 版主
peter460191

TOP

以下的程式碼提供參考......


Sub 成交資訊取得()
    Application.ScreenUpdating = False
    DATE_REQ = CDate(InputBox("請輸入交易日期, 格式 2011/9/6", , Format(Now(), "yyyy/m/d")))
   
    yyyymm = Year(DATE_REQ) & Format(Month(DATE_REQ), "00")
    yyyymmdd = Year(DATE_REQ) & Format(Month(DATE_REQ), "00") & Format(Day(DATE_REQ), "00")
    yyymmdd = Year(DATE_REQ) - 1911 & "/" & Format(Month(DATE_REQ), "00") & "/" & Format(Day(DATE_REQ), "00")
    Application.DisplayAlerts = False
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.twse.com.tw/ch/trading/exchange/MI_INDEX/genpage/Report" & yyyymm & "/A112" & yyyymmdd & "ALLBUT0999_1.php?select2=ALLBUT0999&chk_date=" & yyymmdd & "" _
        , Destination:=Range("A1"))
        .Name = "04"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "10"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Columns("A:A").ColumnWidth = 9.63
    Rows("4:4").Select
    Selection.Delete Shift:=xlUp
    Range("C4").Select
end sub

TOP

回復 16# jsleee

感謝  jsleee
按照所提供的程式真的可以用耶!
但好像只有上市的,如果想要上市加上櫃、興櫃及可轉債(CB)要如何修改,謝謝您的指導。
peter460191

TOP

興櫃的程式碼如下:

Sub 興櫃()
    On Error Resume Next
    Cells.Select
    Selection.QueryTable.Delete
    Selection.ClearContents
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://nweb.gretai.org.tw/emgstk/ch/emgstk.htm", Destination:=Range( _
        "$A$1"))
        .Name = "emgstk_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Columns("A:A").ColumnWidth = 15.88
    Columns("B:B").ColumnWidth = 13.13
End Sub

TOP

可轉債的部分參考如下:

Sub 可轉債()
    Application.ScreenUpdating = False
    DATE_REQ = CDate(InputBox("請輸入交易日期, 格式 2011/9/6", , Format(Now(), "yyyy/m/d")))
   
    yyyymmdd = Year(DATE_REQ) & Format(Month(DATE_REQ), "00") & Format(Day(DATE_REQ), "00")
    Application.DisplayAlerts = False
   
    On Error Resume Next
    Cells.Select
    Selection.QueryTable.Delete
    Selection.ClearContents
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.otc.org.tw/ch/inc/js/ReportCSV.php?NAME=/ch/bond_trading_info/bonds_info/daily/data/rsta0113." & yyyymmdd & "-C.csv&SHOW=1&LEVEL=4" _
        , Destination:=Range("$A$1"))
        .Name = "rsta0113." & yyyymmdd & "-C.csv&SHOW=1&LEVEL=4_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Columns("A:A").ColumnWidth = 17.75
End Sub

TOP

上櫃的部分 如下:

Sub 上櫃()
    Application.ScreenUpdating = False
    DATE_REQ = CDate(InputBox("請輸入交易日期, 格式 2011/9/6", , Format(Now(), "yyyy/m/d")))
   
    yyymmdd = Year(DATE_REQ) - 1911 & Format(Month(DATE_REQ), "00") & Format(Day(DATE_REQ), "00")
    Application.DisplayAlerts = False
    On Error Resume Next
    Cells.Select
    Selection.QueryTable.Delete
    Selection.ClearContents
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.otc.org.tw/ch/stock/aftertrading/DAILY_CLOSE_quotes/RSTA3104_" & yyymmdd & ".html" _
        , Destination:=Range("$A$1"))
        .Name = "RSTA3104_" & yyymmdd & ""
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Columns("A:A").ColumnWidth = 7
End Sub

TOP

回復 21# jsleee


    非常感謝 jsleee
真的非常謝謝你,我會花一點時間好好研究研究。
peter460191

TOP

本帖最後由 peter460191 於 2011-9-16 13:38 編輯

回復 18# peter460191


    再請教  jsleee 前輩

我把全部的程式放在一起,但只會出現一種,想請問要如何讓它同時出現,另外變更日期,除了透過巨集執行外,還有更快或更方便的方法嗎 !請問有方法讓檔案開啟就自動執行最新的日期嗎?
請jsleee 前輩指導一下,再一次感謝您!
peter460191

TOP

回復 25# peter460191

試試看以下的程式碼:但請先在你的 Excel 工作表 建立三個工作表,名稱分別為 "上櫃"、"可轉債"、"興櫃",否則程式會出錯....


Sub 上櫃_可轉債_興櫃()
    '上櫃
    Application.ScreenUpdating = False
    Sheets("上櫃").Select
    DATE_REQ = CDate(Format(Now(), "yyyy/m/d"))
   
PPP1:    yyymmdd = Year(DATE_REQ) - 1911 & Format(Month(DATE_REQ), "00") & Format(Day(DATE_REQ), "00")
    Application.DisplayAlerts = False
    On Error Resume Next
    Cells.Select
    Selection.QueryTable.Delete
    Selection.ClearContents
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.otc.org.tw/ch/stock/aftertrading/DAILY_CLOSE_quotes/RSTA3104_" & yyymmdd & ".html" _
        , Destination:=Range("$A$1"))
        .Name = "RSTA3104_" & yyymmdd & ""
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    On Error GoTo 0
    Columns("A:A").ColumnWidth = 7
    If Cells(1, "A") = "" Then
        DATE_REQ = DATE_REQ - 1
        GoTo PPP1
    End If

   
    Sheets("可轉債").Select
    yyyymmdd = Year(DATE_REQ) & Format(Month(DATE_REQ), "00") & Format(Day(DATE_REQ), "00")
    On Error Resume Next
    Cells.Select
    Selection.QueryTable.Delete
    Selection.ClearContents
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.otc.org.tw/ch/inc/js/ReportCSV.php?NAME=/ch/bond_trading_info/bonds_info/daily/data/rsta0113." & yyyymmdd & "-C.csv&SHOW=1&LEVEL=4" _
        , Destination:=Range("$A$1"))
        .Name = "rsta0113." & yyyymmdd & "-C.csv&SHOW=1&LEVEL=4_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    On Error GoTo 0
    Columns("A:A").ColumnWidth = 17.75
   
    '興櫃
    Sheets("興櫃").Select
    Cells.Select
    On Error Resume Next
    Selection.QueryTable.Delete
    Selection.ClearContents
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://nweb.gretai.org.tw/emgstk/ch/emgstk.htm", Destination:=Range( _
        "$A$1"))
        .Name = "emgstk_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    On Error GoTo 0
    Columns("A:A").ColumnWidth = 15.88
    Columns("B:B").ColumnWidth = 13.13

End Sub

TOP

        靜思自在 : 發脾氣是短暫的發瘋。
返回列表 上一主題