- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
8#
發表於 2013-10-12 15:43
| 只看該作者
回復 7# gelai01000001
試試看- Option Explicit
- Sub 下載網站資料()
- Dim Startmonth As String, Startday As String, xDate As Date, Msg As Boolean, Sh As Worksheet
- Dim Wb As Workbook, Ws As Worksheet, Stock As Range
- On Error GoTo EX '程式執行中有錯誤時跳到 EX: 繼續執行程式
- xDate = Date '當日
- Set Sh = Workbooks.Add.Sheets(1) '新活頁簿的第一個工作表
- EX:
- If Err.Number <> 0 Or Msg = True Then '當日(尚未有資料:錯誤) 或 休市
- xDate = xDate - 1 '往後退一天一直到開市. ( 假如休市超過1天以上(2,3,4,5,6,春節9天)
- Err.Clear
- Msg = False
- End If
- Startday = Format(xDate, "YYYYMMDD")
- Startmonth = Format(xDate, "YYYYMM")
- '下載網站的網址
- With Sh.QueryTables.Add(Connection:="URL;http://www.twse.com.tw/ch/trading/exchange/MI_INDEX/genpage/Report" & Startmonth & "/A112" & Startday & "ALLBUT0999_1.php?select2=ALLBUT0999&chk_date=" & Format(xDate, "E/MM/DD"), Destination:=Range("A3"))
- .RefreshStyle = xlOverwriteCells '抓取網頁的第10個表格作為匯入資料
- .WebTables = "10"
- .Refresh BackgroundQuery:=False '當日(尚未有資料:錯誤)
- If Application.CountA(Sh.QueryTables(1).ResultRange) = 0 Then '休市 沒有資料
- Msg = True
- GoTo EX
- End If
- End With
- For Each Wb In Workbooks
- For Each Ws In Wb.Sheets
- Set Stock = Sh.[A:A].Find(Ws.Name, lookat:=xlWhole)
- If Not Stock Is Nothing Then
- Stock.Offset(, 2).Resize(, 14).Copy
- With Ws
- With .Range("a" & .Rows.Count).End(xlUp).Offset(1)
- .Cells = xDate
- .Offset(, 1).PasteSpecial xlPasteValuesAndNumberFormats
- End With
- End With
- End If
- Next
- Next
- Sh.Parent.Close False '關閉: 新活頁簿的第一個工作表
- End Sub
複製代碼 |
|