- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
7#
發表於 2013-9-20 16:20
| 只看該作者
回復 6# pupai - Option Explicit
- Sub GetData()
- Dim DataSheet As Worksheet, Sh As Worksheet, Msg As Boolean
- Dim EndDate As Date, StartDate As Date, i As Integer, AR, xR As Long
- Dim Symbol As String, Qur As String
- Set DataSheet = Sheets("Sheet1")
- With DataSheet
- StartDate = .[b1]
- EndDate = .[b2]
- Symbol = .[b3]
- .Range("D1").CurrentRegion = ""
- End With
- '本資料自民國94年09月01日開始提供 *** 除錯 ***
- If StartDate < #9/1/2005# Or EndDate < #9/1/2005# Or Len(Symbol) <= 3 Or StartDate > EndDate Or EndDate > Date Then
- MsgBox "數據有誤" & IIf(StartDate < #9/1/2005#, vbLf & "StartDate :日期 小於 94年09月01日 ", "") & _
- IIf(EndDate < #9/1/2005#, vbLf & "EndDate :日期 小於 94年09月01日 ", "") & _
- IIf(Len(Symbol) <= 3, vbLf & "Symbol : 股票代號 ", "") & _
- IIf(StartDate > EndDate, vbLf & "StartDate > EndDate", "") & _
- IIf(EndDate > Date, vbLf & " EndDate >" & Date, "")
- Exit Sub
- End If
- '*********************************************
- Set Sh = Sheets.Add(Sheets(1))
- DataSheet.Activate
- Do While DateSerial(Year(StartDate), Month(StartDate), 1) <= EndDate
- Qur = "http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU.php?myear=" & Format(StartDate, "yyyy") & "&mmon=" & Format(StartDate, "m") & "&STK_NO=" & Symbol
- With Sh
- If .QueryTables.Count = 0 Then
- .QueryTables.Add "URL;" & Qur, .[A1]
- Else
- .QueryTables(1).Connection = "URL;" & Qur
- Msg = True
- End If
- With .QueryTables(1)
- .WebFormatting = xlWebFormattingNone
- .WebSelectionType = xlSpecifiedTables
- .WebDisableDateRecognition = True
- .WebTables = "8"
- .Refresh BackgroundQuery:=False
- If Application.CountA(.ResultRange) = 0 Then Msg = False
- If Msg Then
- AR = .ResultRange.Offset(2)
- Else
- AR = .ResultRange
- End If
- With DataSheet
- xR = Application.CountA(.[d:d]) + 1
- .Cells(xR, "D").Resize(UBound(AR, 1), UBound(AR, 2)) = AR
- End With
- End With
- End With
- StartDate = DateAdd("m", 1, StartDate)
- Loop
- Application.DisplayAlerts = False
- Sh.Delete
- Application.DisplayAlerts = True
- End Sub
複製代碼 |
|