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

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

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

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

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

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

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