- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 1# cji3cj6xu6
修改如下- Option Explicit
- Sub GGetPrice()
- Dim StartYear, StockNumber As Integer, URL As String, xlMonth As String, R As Integer, R1 As Integer
- StartYear = 2013
- StartYear = DateSerial(StartYear, 1, 0) '起始日=>去年最後一天
- StockNumber = 1101 '股票代號
- Sheets(1).Cells.Clear '清除欲存放的頁面
- On Error Resume Next '外部查詢的網址有誤會有錯誤(日期超過)
- Do While Err.Number = 0
- StartYear = DateAdd("M", 1, StartYear) '起始日的下一個月日期
- xlMonth = Format(StartYear, "YYYYMM") & "/" & Format(StartYear, "YYYYMM")
- URL = "URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & xlMonth & "_F3_1_8_" & StockNumber & ".php?STK_NO=" & StockNumber & "&myear=" & Format(StartYear, "YYYY") & "&mmon=" & Format(StartYear, "MM")
- With Sheets(2) '清除抓取資料存放的頁面
- If .QueryTables.Count = 0 Then
- With .QueryTables.Add(URL, .[A1])
- .Refresh BackgroundQuery:=False
- End With
- End If
- With .QueryTables(1)
- .Connection = URL
- .WebSelectionType = xlSpecifiedTables
- .WebFormatting = xlWebFormattingNone
- .WebTables = "8"
- .WebPreFormattedTextToColumns = False
- .WebConsecutiveDelimitersAsOne = False
- .WebSingleBlockTextImport = False
- .WebDisableDateRecognition = True
- .WebDisableRedirections = True
- .Refresh BackgroundQuery:=False
- With .ResultRange
- R = Application.CountA(Sheets(1).[A:A])
- R1 = IIf(R = 0, 3, 4)
- .Rows(R1).Resize(.Rows.Count - R1 + 1).Copy Sheets(1).Cells(R + 1, 1)
- End With
- End With
- End With
- Loop
- Sheets(1).Columns.AutoFit
- MsgBox "OK!"
- End Sub
|
|
發表於 2013-7-4 14:07
| 