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