12
返回列表 上一主題 發帖

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

jsleee

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

jsleee

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

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

jsleee

帖子
151 
主題
25 
精華
0 
積分
194 
點名
0  
作業系統
WINDOWS 10 
軟體版本
Office 2010 或 2021 
閱讀權限
20 
性別
男 
註冊時間
2011-9-6 
最後登錄
2024-11-8 
6#
發表於 2011-9-19 21:40 | 顯示全部帖子
回復 21# peter460191

很抱歉，我還沒有權限下載檔案....
請將錯誤畫面擷取貼上來.....
這樣才有辦法知道你的問題點

TOP

jsleee

帖子
151 
主題
25 
精華
0 
積分
194 
點名
0  
作業系統
WINDOWS 10 
軟體版本
Office 2010 或 2021 
閱讀權限
20 
性別
男 
註冊時間
2011-9-6 
最後登錄
2024-11-8 
7#
發表於 2011-9-21 21:58 | 顯示全部帖子
回復 23# peter460191

抱歉，我反覆測試，還是遇不到你的問題點.....
再過幾天，也許我的點數夠了，就可以下載你的檔案測試了.....

TOP

jsleee

帖子
151 
主題
25 
精華
0 
積分
194 
點名
0  
作業系統
WINDOWS 10 
軟體版本
Office 2010 或 2021 
閱讀權限
20 
性別
男 
註冊時間
2011-9-6 
最後登錄
2024-11-8 
8#
發表於 2011-9-24 21:43 | 顯示全部帖子
回復 21# peter460191


    請將 總表內的程式碼 移到 模組中，即可.....
    請參考附件....

更新收盤價.rar (182.49 KB)

TOP

jsleee

帖子
151 
主題
25 
精華
0 
積分
194 
點名
0  
作業系統
WINDOWS 10 
軟體版本
Office 2010 或 2021 
閱讀權限
20 
性別
男 
註冊時間
2011-9-6 
最後登錄
2024-11-8 
9#
發表於 2011-9-26 22:34 | 顯示全部帖子
回復 28# peter460191

麻煩把 你合併後的檔案放上來，我確認看看.....
另外，四個表要合併有困難，因為欄位不太一樣，如何合併？這個部分要麻煩你先想看看，合併的結果要長甚麼樣子

TOP

jsleee

帖子
151 
主題
25 
精華
0 
積分
194 
點名
0  
作業系統
WINDOWS 10 
軟體版本
Office 2010 或 2021 
閱讀權限
20 
性別
男 
註冊時間
2011-9-6 
最後登錄
2024-11-8 
10#
發表於 2011-9-28 22:01 | 顯示全部帖子
回復 30# peter460191


    請問 可轉債 的 等價、議價 各代表甚麼含意？
    因為要將 資料合併，在 可轉債的部分，同一項代號 有些 收市 會同時有 等價、議價 兩筆，
    請問要抓哪一筆？

TOP

        靜思自在 : 多做多得。少做多失。
12
返回列表 上一主題