標題:
Web 資料 匯入 問題
[打印本頁]
作者:
seemee
時間:
2013-5-16 21:20
標題:
Web 資料 匯入 問題
[attach]14997[/attach]
這是我改別人寫的
跑一半會進入無限迴圈 請問怎麼寫判斷停止條件?
第二頁..之後 怎麼刪除前兩列(原本只刪除一列)?
請前輩賜教
作者:
seemee
時間:
2013-5-16 21:23
.ResultRange(2).EntireRow.Delete 原本是(1)
改成2之後還是刪除一列
作者:
Hsieh
時間:
2013-5-16 23:07
回復
2#
seemee
Sub 個股交易明細下載()
Dim 股票代號 As String, 年 As String, 月 As String, N As Name, i As Integer, T As Integer, A
年 = 2013
月 = 1
月 = Format(月, "00")
股票代號 = 2330
T = Time
With ActiveSheet
.Cells.Clear
DoEvents
'Application.ScreenUpdating = False
'Application.StatusBar = False
With .QueryTables.Add(Connection:="URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & 年 & 月 & "/" & 年 & 月 & "_F3_1_8_" & 股票代號 & ".php?STK_NO=" & 股票代號 & "&myear=" & 年 & "&mmon=" & 月, Destination:=Range("A1"))
.BackgroundQuery = True
.WebTables = "8"
.Refresh BackgroundQuery:=False
ActiveSheet.Names(.Name).Delete
End With
月 = 2
Do
月 = Format(月, "00")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Select
With .QueryTables.Add(Connection:="URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & 年 & 月 & "/" & 年 & 月 & "_F3_1_8_" & 股票代號 & ".php?STK_NO=" & 股票代號 & "&myear=" & 年 & "&mmon=" & 月, Destination:=Selection)
.BackgroundQuery = True
.WebTables = "8"
On Error Resume Next
Do
Err.Clear
.Refresh BackgroundQuery:=False
If Err.Number = 1004 Then GoTo 10 '無法開啟檔案就跳到下一月
Loop Until Err.Number = 0
On Error GoTo 0
If Application.CountA(.ResultRange) = 0 Then GoTo OUT
.ResultRange.Rows("1:2").Delete '刪除1:2列
ActiveSheet.Names(.Name).Delete
10
月 = 月 + 1
End With
Loop Until 月 > 12
OUT:
.[A1].Select
Application.ScreenUpdating = True
With .UsedRange
.WrapText = False
.Interior.ColorIndex = xlNone
.Font.Size = 12
.Columns.AutoFit
A = CreateObject("WScript.Shell").popup("共下載 " & i & " 頁費時 " & Format(Time - T, "hh:mm分SS秒"), 5, 年 & "_" & 股票代號, 48 + 0)
Application.StatusBar = 年 & " _ " & 股票代號 & " 共下載 " & i & "頁 費時 " & Format(Time - T, "HH:MM:SS")
End With
For Each N In .Names
N.Delete
Next
End With
End Sub
複製代碼
作者:
seemee
時間:
2013-5-17 16:46
感謝大大 解答了 我這兩天的困擾:D
不小心爬文找到下面的程式碼
但是新的問題又來囉 再次麻煩大大了
問題
1. ?myear=" & Myear & "&mmon=" & Mmon 這段程式碼要怎麼取得, 在網頁的網址沒顯示這段
我有請教別人 PHP POST 沒辦法知道 但是 這段程式碼是怎麼弄來的,好奇?
2. 匯入的資料暫存怎麼指定到U欄,AB欄開始 我看不出裡面有語法指定這個位置?
Sub 大盤歷史成交資訊_連續月_排序()
Dim Q(1 To 2) As QueryTable, xlData As Date, Myear, Mmon, i As Integer
With Sheets("加權歷史行情")
.Range("E1").CurrentRegion.Offset(1).Clear
.Range("E1").CurrentRegion.Select
Application.ScreenUpdating = False
Set Q(1) = .QueryTables(1)
Set Q(2) = .QueryTables(2)
For i = .[b4] - 1 To 0 Step -1
xlData = DateAdd("m", -i, DateSerial(.[b1] + 1911, .[b2], 1))
Myear = Year(xlData) - 1911 '民國年
Mmon = Format(Month(xlData), "00")
With Q(1)
.Connection = "URL;http://www.twse.com.tw/ch/trading/indices/MI_5MINS_HIST/MI_5MINS_HIST.php?myear=" & Myear & "&mmon=" & Mmon ' 問題1
.WebTables = "8"
.Refresh BackgroundQuery:=False
.ResultRange.Offset(2).Copy .Parent.Cells(Rows.Count, "E").End(xlUp).Offset(1)
End With
With Q(2)
.Connection = "URL;http://www.twse.com.tw/ch/trading/exchange/FMTQIK/genpage/Report" & Year(xlData) & Mmon & "/" & Year(xlData) & Mmon & "_F3_1_2.php?STK_NO=&myear=" & Year(xlData) & "&mmon=" & Mmon
Q(2).WebTables = "8"
Q(2).Refresh BackgroundQuery:=False
.ResultRange.Columns(2).Offset(2).Copy .Parent.Cells(Rows.Count, "J").End(xlUp).Offset(1)
.ResultRange.Columns(6).Offset(2).Copy .Parent.Cells(Rows.Count, "K").End(xlUp).Offset(1)
End With
Next
.Range("E1").CurrentRegion.EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
MsgBox "匯入完成 !!! "
End Sub
複製代碼
[attach]15002[/attach]
作者:
GBKEE
時間:
2013-5-18 08:36
本帖最後由 GBKEE 於 2013-5-18 08:48 編輯
回復
4#
seemee
問題1
Myear
= Year(xlData) - 1911 '民國年
Mmon
= Format(Month(xlData), "00")
With Q(1)
.Connection = "URL;
http://www.twse.com.tw/ch/trading/indices/MI_5MINS_HIST/MI_5MINS_HIST.php?myear=
" &
Myear
& "&mmon=" &
Mmon
顯示網址後比對一下:'"URL;
http://www.twse.com.tw/ch/trading/indices/MI_5MINS_HIST/MI_5MINS_HIST.php?myear=
101
&mmon=
04
"
問題2
With Q(1)
.ResultRange.Offset(2).Copy .Parent.Cells(Rows.Count, "E").End(xlUp).Offset(1)
End With
.ResultRange.Offset(2).Copy -> 這範圍的複製
.ResultRange->外部資料來源傳回
資料的範圍
.Offset(2) ->
資料的範圍
下移2列
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
.Parent.Cells(Rows.Count, "E").End(xlUp).Offset(1) ->Q(1)物件工作表.E欄底部.往上到有資料的列.下移1列
.Parent -> Q(1)物件的父層: 所在的工作表
Rows.Count ->工作表列的總數
.Cells(Rows.Count, "E") ->E欄最後一列
.End(xlUp) ->往上: xlUp 到有資料的列
.Offset(1) ->
資料的範圍
下移1列
'**********************************************************************
.ResultRange.Offset(2).Copy .Parent.Cells(Rows.Count, "E").End(xlUp).Offset(1)
外部資料來源傳回
資料的範圍
下移2列.複製 貼上位置(
物件工作表.E欄最後一列.往上到有資料的列.下移1列
)
作者:
seemee
時間:
2013-5-18 14:24
先謝謝大大詳細的回答
我發覺我的問題問的不好
問題
1. 在網頁上只看到http://www.twse.com.tw/ch/trading/indices/MI_5MINS_HIST/MI_5MINS_HIST.php
換日期查詢依然只看到http://www.twse.com.tw/ch/trading/indices/MI_5MINS_HIST/MI_5MINS_HIST.php
那後面這段?myear=101&mmon=04" 是從何得知?
2.
.QueryTables.Add(Connection:="URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & 年 & 月 & "/" & 年 & 月 & "_F3_1_8_" & 股票代號 & ".php?STK_NO=" & 股票代號 & "&myear=" & 年 & "&mmon=" & 月,
Destination:=Range("A1")
)
Destination:=Range("A1")這是指定最左上的儲存格
"URL;http://www.twse.com.tw/ch/trading/exchange/FMTQIK/genpage/Report" & Year(xlData) & Mmon & "/" & Year(xlData) & Mmon & "_F3_1_2.php?STK_NO=&myear=" & Year(xlData) & "&mmon=" & Mmon
沒有Destination
那怎麼知道 ResultRange 要放哪裡?
作者:
seemee
時間:
2013-5-19 00:17
再補充一個問題
日期部份 1999/12/31
100/01/03
到100年會變成民國顯示
請問怎麼週整
[attach]15014[/attach]
作者:
GBKEE
時間:
2013-5-19 06:45
回復
6#
seemee
Q1: 從4#這段程式碼裡得知
10. xlData = DateAdd("m", -i, DateSerial(.[b1] + 1911, .[b2], 1))
11. Myear = Year(xlData) - 1911 '民國年
12. Mmon = Format(Month(xlData), "00")
複製代碼
Q2 :
沒有Destination 那怎麼知道 ResultRange 要放哪裡?
從4#這段程式碼裡得知 是已存在外部查詢 ,不須指定Destination
07. Set Q(1) = .QueryTables(1)
08. Set Q(2) = .QueryTables(2)
複製代碼
回復
7#
seemee
這裡有答案
作者:
seemee
時間:
2013-5-19 23:52
本帖最後由 seemee 於 2013-5-19 23:55 編輯
回復
8#
GBKEE
我還是不太懂問題
1.
?myear=
101
&mmon=
04 我指的是怎麼知道要加這些 網頁上的網址沒有顯示
2.[attach]15029[/attach]沒有加Destination 但是他的外部資料暫存是在U欄開始 是預設從U欄開始嗎?
[attach]15028[/attach] 如果資料範圍超過U欄 會造成資料重疊 而錯誤
謝謝版主的耐心回答
作者:
GBKEE
時間:
2013-5-20 07:19
回復
9#
seemee
Q1: Google搜尋 WEB查詢
Q2: 請詳看
個股歷史行情TEST1
這一行程式碼的內容
.ResultRange.Offset(2).Copy .Parent.Cells(Rows.Count,
"S"
).End(xlUp).Offset(1)
這位置
"S"
是S欄, 請比對 [加權歷史行情] 相對的程式碼 複製到的位置在哪裡?
With Q(2) '個股歷史行情TEST1T程式碼
.Connection = "URL;http://www.twse.com.tw/ch/trading/exchange/FMTQIK/genpage/Report" & Year(xlData) & Mmon & "/" & Year(xlData) & Mmon & "_F3_1_2.php?STK_NO=&myear=" & Year(xlData) & "&mmon=" & Mmon
Q(2).WebTables = "8"
Q(2).Refresh BackgroundQuery:=False
.ResultRange.Offset(2).Copy .Parent.Cells(Rows.Count, "S").End(xlUp).Offset(1)
End With
複製代碼
作者:
seemee
時間:
2013-5-20 23:26
回復
10#
GBKEE
感謝感謝 前輩的詳細解答依我的功力 可能要消化好一陣子了.
作者:
lalalada
時間:
2013-5-21 14:27
回復
9#
seemee
我知道你想問什麼~
去找一套叫fiddler的軟體(freeware for personal use)
他可以幫你找出post的值
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)