暱稱: 沙拉油 頭銜: 正港A水電工
超級版主
- 帖子
- 44
- 主題
- 2
- 精華
- 0
- 積分
- 49
- 點名
- 0
- 作業系統
- Windows XP SP3
- 軟體版本
- Office 2003
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 呆丸
- 註冊時間
- 2010-5-1
- 最後登錄
- 2013-1-27
 
|
2#
發表於 2011-1-21 23:28
| 只看該作者
本帖最後由 沙拉油 於 2011-1-21 23:40 編輯
不保證回傳資料的完整性- Sub webqyt()
- Dim qyt As QueryTable
- Dim sh As Worksheet
- Dim i As Integer
- Dim para As String
- Dim paras As Variant
- Dim rng As Range
-
- paras = Array("股票代號", "開始日期（西元）", "結束日期（西元）")
- Application.ScreenUpdating = False
- Set sh = Sheets.Add
- '建立WEB查詢
- Set qyt = sh.QueryTables.Add(Connection:= _
- "FINDER;http://oilonline.myweb.hinet.net/m.iqy", _
- Destination:=Range("A1"))
- '設定參數 1 to 3
- For i = 1 To 3
- para = InputBox("請輸入要查詢的" & paras(i - 1), "查詢參數 " & i & "/3")
- Select Case i
- Case 1: If Not IsNumeric(para) Then GoTo ERROUT
- Case 2: If Not IsDate(para) Then GoTo ERROUT
- Case 3: If Not IsDate(para) Then GoTo ERROUT
- End Select
- qyt.Parameters(i).SetParam xlConstant, IIf(i > 1, Format(para, "yyyy-m-d"), para)
- Next
- Sheet1.Cells.Clear
- i = 1
- '開始查詢
- Do
- qyt.Parameters(4).SetParam xlConstant, i
- qyt.Refresh False
- With qyt.ResultRange
- If .Rows.Count > 4 Then
- Set rng = Range("A" & IIf(i = 1, 1, 3)).Resize(.Rows.Count - IIf(i = 1, 2, 4), .Columns.Count)
- rng.Copy Sheet1.Range("A65536").End(xlUp).Offset(IIf(i = 1, 0, 1), 0)
- End If
- End With
- Set rng = Cells.Find(what:="下一頁", LookIn:=xlValues, Lookat:=xlPart)
- i = i + 1
- Loop While Not rng Is Nothing
- Application.DisplayAlerts = False
- sh.Delete
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- Exit Sub
- ERROUT:
- Application.DisplayAlerts = False
- sh.Delete
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- MsgBox "你提供的資料明顯不正確，不查了∼"
- End Sub
下次同樣的問題就不答了∼ |
|
發表於 2011-1-16 09:27
| 
