12345678
返回列表 上一主題 發帖

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

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
11# 跳轉到 »
發表於 2011-7-13 13:24 | 只看該作者
本帖最後由 GBKEE 於 2011-7-13 13:27 編輯

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

TOP

peter460191

帖子
163 
主題
27 
精華
0 
積分
193 
點名
0  
作業系統
winsows 10 
軟體版本
Office 2016 
閱讀權限
20 
性別
男 
註冊時間
2010-12-20 
最後登錄
2024-5-9 
12#
發表於 2011-7-13 14:43 | 只看該作者
回復 13# GBKEE


    非常謝謝GBKEE 版主
peter460191

TOP

jsleee

帖子
151 
主題
25 
精華
0 
積分
194 
點名
0  
作業系統
WINDOWS 10 
軟體版本
Office 2010 或 2021 
閱讀權限
20 
性別
男 
註冊時間
2011-9-6 
最後登錄
2024-11-8 
13#
發表於 2011-9-6 21:38 | 只看該作者
以下的程式碼提供參考......


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

peter460191

帖子
163 
主題
27 
精華
0 
積分
193 
點名
0  
作業系統
winsows 10 
軟體版本
Office 2016 
閱讀權限
20 
性別
男 
註冊時間
2010-12-20 
最後登錄
2024-5-9 
14#
發表於 2011-9-8 14:33 | 只看該作者
回復 16# jsleee

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

TOP

jsleee

帖子
151 
主題
25 
精華
0 
積分
194 
點名
0  
作業系統
WINDOWS 10 
軟體版本
Office 2010 或 2021 
閱讀權限
20 
性別
男 
註冊時間
2011-9-6 
最後登錄
2024-11-8 
15#
發表於 2011-9-8 22:12 | 只看該作者
興櫃的程式碼如下：

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

jsleee

帖子
151 
主題
25 
精華
0 
積分
194 
點名
0  
作業系統
WINDOWS 10 
軟體版本
Office 2010 或 2021 
閱讀權限
20 
性別
男 
註冊時間
2011-9-6 
最後登錄
2024-11-8 
16#
發表於 2011-9-8 22:26 | 只看該作者
可轉債的部分參考如下：

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

jsleee

帖子
151 
主題
25 
精華
0 
積分
194 
點名
0  
作業系統
WINDOWS 10 
軟體版本
Office 2010 或 2021 
閱讀權限
20 
性別
男 
註冊時間
2011-9-6 
最後登錄
2024-11-8 
17#
發表於 2011-9-8 22:37 | 只看該作者
上櫃的部分 如下：

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

peter460191

帖子
163 
主題
27 
精華
0 
積分
193 
點名
0  
作業系統
winsows 10 
軟體版本
Office 2016 
閱讀權限
20 
性別
男 
註冊時間
2010-12-20 
最後登錄
2024-5-9 
18#
發表於 2011-9-13 17:25 | 只看該作者
回復 21# jsleee


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

TOP

peter460191

帖子
163 
主題
27 
精華
0 
積分
193 
點名
0  
作業系統
winsows 10 
軟體版本
Office 2016 
閱讀權限
20 
性別
男 
註冊時間
2010-12-20 
最後登錄
2024-5-9 
19#
發表於 2011-9-15 11:57 | 只看該作者
本帖最後由 peter460191 於 2011-9-16 13:38 編輯

回復 18# peter460191


    再請教  jsleee 前輩

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

TOP

jsleee

帖子
151 
主題
25 
精華
0 
積分
194 
點名
0  
作業系統
WINDOWS 10 
軟體版本
Office 2010 或 2021 
閱讀權限
20 
性別
男 
註冊時間
2011-9-6 
最後登錄
2024-11-8 
20#
發表於 2011-9-17 09:43 | 只看該作者
回復 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

        靜思自在 : 時時好心就是時時好日。
12345678
返回列表 上一主題