請問有什麼方法可以在excel上自動更新目前所有上市櫃股票收盤價 - Excelㄧ般區

帖子: 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

中學生 Rank: 2

帖子: 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

中學生 Rank: 2

帖子: 151
主題: 25
精華: 0
積分: 194
點名: 1
作業系統: 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

中學生 Rank: 2

帖子: 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

中學生 Rank: 2

帖子: 151
主題: 25
精華: 0
積分: 194
點名: 1
作業系統: 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

中學生 Rank: 2

帖子: 151
主題: 25
精華: 0
積分: 194
點名: 1
作業系統: 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

中學生 Rank: 2

帖子: 151
主題: 25
精華: 0
積分: 194
點名: 1
作業系統: 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

中學生 Rank: 2

帖子: 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

中學生 Rank: 2

帖子: 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

中學生 Rank: 2

帖子: 151
主題: 25
精華: 0
積分: 194
點名: 1
作業系統: 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

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

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]