- 帖子
- 8
- 主題
- 1
- 精華
- 0
- 積分
- 9
- 點名
- 0
- 作業系統
- wiinXP
- 軟體版本
- 1.2.8.1
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2014-2-24
- 最後登錄
- 2014-3-18
|
10#
發表於 2014-3-5 11:53
| 只看該作者
請問高手:)
基於原查詢程式WebQ000程式
我又寫了一個自動分頁的程式Addpage000
想實現
1.依名單"list"自動產生"股號別"分頁
2.偵測為每分頁空白後自動貼上資料
請問是哪裡出了錯?
可否指點一下~?
-------------------------
Sub Addpages000() 'OK的自動分頁
Dim ii, yy 'ii自動數list yy年/月
Dim stock 'stock股號與表名
Dim ptxt As String '連線用
ii = 2 '起始
yy = 103 / 1 '先用定數
Do While Worksheets("list").Cells(ii, 1) <> ""
stock = Worksheets("list").Cells(ii, 1)
Worksheets.Add
ActiveSheet.Name = stock
Application.Wait Now + TimeValue("00:00:01") 'wait 1s
ii = ii + 1
Loop
End Sub
Sub WebQ000() 'OK的網路查詢
Dim ptxt As String
Dim yy, stock
Dim ii
ii = 2
yy = 103 / 1
stock = Worksheets("list").Cells(ii, 1)
If Worksheets("list").Cells(ii, 1) = 0 Then
Worksheets(ii).Selection
ActiveSheet.QueryTables.Add Connection:="URL;", Destination:=Range("A1")
.Connection = "URL;http://www.otc.org.tw/ch/emergingstock/single_historical/result.php"
.PreserveFormatting = False
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebDisableDateRecognition = True
.PostText = "ajax=true&input_month=" & yy & "&input_emgstk_code=" & stock
.Refresh False
Application.Wait Now + TimeValue("00:00:01") 'wait 1s
ii = ii + 1
Else: Exit Sub
End If
-----------------------------------------------
 test004自動分頁儲存.rar (14.86 KB)
|
|
