12
返回列表 上一主題 發帖

Web 資料 匯入 問題

seemee

帖子
93 
主題
15 
精華
0 
積分
111 
點名
0  
作業系統
win7 
軟體版本
Office 2010 X86 
閱讀權限
20 
性別
男 
註冊時間
2012-7-3 
最後登錄
2020-12-3 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-5-16 21:20 | 只看該作者

Web 資料 匯入 問題

qq.rar (24.03 KB)
這是我改別人寫的
跑一半會進入無限迴圈 請問怎麼寫判斷停止條件?
第二頁..之後  怎麼刪除前兩列(原本只刪除一列)?
請前輩賜教
收藏 分享

seemee

帖子
93 
主題
15 
精華
0 
積分
111 
點名
0  
作業系統
win7 
軟體版本
Office 2010 X86 
閱讀權限
20 
性別
男 
註冊時間
2012-7-3 
最後登錄
2020-12-3 
2#
發表於 2013-5-16 21:23 | 只看該作者
.ResultRange(2).EntireRow.Delete   原本是(1)
改成2之後還是刪除一列

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
47  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-2-23 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 2013-5-16 23:07 | 只看該作者
回復 2# seemee
  1. Sub 個股交易明細下載()
  2.     Dim 股票代號 As String, 年 As String, 月 As String, N As Name, i As Integer, T As Integer, A
  3.     年 = 2013
  4.     月 = 1
  5.     月 = Format(月, "00")
  6.     股票代號 = 2330
  7.    
  8.     T = Time
  9.     With ActiveSheet
  10.         .Cells.Clear
  11.         DoEvents
  12.         'Application.ScreenUpdating = False
  13.         'Application.StatusBar = False
  14.         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"))
  15.             .BackgroundQuery = True
  16.             .WebTables = "8"
  17.             .Refresh BackgroundQuery:=False
  18.             ActiveSheet.Names(.Name).Delete
  19.         End With
  20.         月 = 2
  21.         
  22.         Do
  23.              月 = Format(月, "00")
  24.             .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Select
  25.             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)
  26.                 .BackgroundQuery = True
  27.                 .WebTables = "8"
  28.                 On Error Resume Next
  29.                 Do
  30.                      Err.Clear
  31.                 .Refresh BackgroundQuery:=False
  32.                 If Err.Number = 1004 Then GoTo 10 '無法開啟檔案就跳到下一月
  33.                 Loop Until Err.Number = 0
  34.                 On Error GoTo 0
  35.                 If Application.CountA(.ResultRange) = 0 Then GoTo OUT
  36.                 .ResultRange.Rows("1:2").Delete '刪除1:2列
  37.                 ActiveSheet.Names(.Name).Delete
  38. 10
  39.                 月 = 月 + 1
  40.             End With
  41.         Loop Until 月 > 12
  42. OUT:
  43.         .[A1].Select
  44.         Application.ScreenUpdating = True
  45.         With .UsedRange
  46.             .WrapText = False
  47.             .Interior.ColorIndex = xlNone
  48.             .Font.Size = 12
  49.             .Columns.AutoFit
  50.             A = CreateObject("WScript.Shell").popup("共下載 " & i & " 頁費時  " & Format(Time - T, "hh:mm分SS秒"), 5, 年 & "_" & 股票代號, 48 + 0)
  51.             Application.StatusBar = 年 & " _ " & 股票代號 & " 共下載 " & i & "頁 費時 " & Format(Time - T, "HH:MM:SS")
  52.         End With
  53.         For Each N In .Names
  54.             N.Delete
  55.         Next
  56.      End With
  57. End Sub
複製代碼
學海無涯_不恥下問

TOP

seemee

帖子
93 
主題
15 
精華
0 
積分
111 
點名
0  
作業系統
win7 
軟體版本
Office 2010 X86 
閱讀權限
20 
性別
男 
註冊時間
2012-7-3 
最後登錄
2020-12-3 
4#
發表於 2013-5-17 16:46 | 只看該作者
感謝大大 解答了 我這兩天的困擾:D
不小心爬文找到下面的程式碼
但是新的問題又來囉 再次麻煩大大了
問題
1. ?myear=" & Myear & "&mmon=" & Mmon  這段程式碼要怎麼取得, 在網頁的網址沒顯示這段
    我有請教別人 PHP POST 沒辦法知道 但是 這段程式碼是怎麼弄來的,好奇?
2. 匯入的資料暫存怎麼指定到U欄,AB欄開始 我看不出裡面有語法指定這個位置?
  1.   Sub 大盤歷史成交資訊_連續月_排序()
  2.     Dim Q(1 To 2) As QueryTable, xlData As Date, Myear, Mmon, i As Integer
  3.     With Sheets("加權歷史行情")
  4.         .Range("E1").CurrentRegion.Offset(1).Clear
  5.         .Range("E1").CurrentRegion.Select
  6.         Application.ScreenUpdating = False
  7.         Set Q(1) = .QueryTables(1)
  8.         Set Q(2) = .QueryTables(2)
  9.         For i = .[b4] - 1 To 0 Step -1
  10.             xlData = DateAdd("m", -i, DateSerial(.[b1] + 1911, .[b2], 1))
  11.             Myear = Year(xlData) - 1911 '民國年
  12.             Mmon = Format(Month(xlData), "00")
  13.             With Q(1)
  14.                 .Connection = "URL;http://www.twse.com.tw/ch/trading/indices/MI_5MINS_HIST/MI_5MINS_HIST.php?myear=" & Myear & "&mmon=" & Mmon ' 問題1
  15.                 .WebTables = "8"
  16.                 .Refresh BackgroundQuery:=False
  17.                 .ResultRange.Offset(2).Copy .Parent.Cells(Rows.Count, "E").End(xlUp).Offset(1)
  18.             End With
  19.             With Q(2)
  20.                 .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
  21.                 Q(2).WebTables = "8"
  22.                 Q(2).Refresh BackgroundQuery:=False
  23.                 .ResultRange.Columns(2).Offset(2).Copy .Parent.Cells(Rows.Count, "J").End(xlUp).Offset(1)
  24.                 .ResultRange.Columns(6).Offset(2).Copy .Parent.Cells(Rows.Count, "K").End(xlUp).Offset(1)
  25.             End With
  26.         Next
  27.         .Range("E1").CurrentRegion.EntireColumn.AutoFit
  28.     End With
  29.     Application.ScreenUpdating = True
  30.     MsgBox "匯入完成  !!! "
  31. End Sub
複製代碼
加權歷史行情.rar (15.27 KB)

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 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列)



感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

seemee

帖子
93 
主題
15 
精華
0 
積分
111 
點名
0  
作業系統
win7 
軟體版本
Office 2010 X86 
閱讀權限
20 
性別
男 
註冊時間
2012-7-3 
最後登錄
2020-12-3 
6#
發表於 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 要放哪裡?

TOP

seemee

帖子
93 
主題
15 
精華
0 
積分
111 
點名
0  
作業系統
win7 
軟體版本
Office 2010 X86 
閱讀權限
20 
性別
男 
註冊時間
2012-7-3 
最後登錄
2020-12-3 
7#
發表於 2013-5-19 00:17 | 只看該作者
再補充一個問題
日期部份 1999/12/31
                  100/01/03
到100年會變成民國顯示
請問怎麼週整


個股歷史行情.rar (31.57 KB)

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2013-5-19 06:45 | 只看該作者
回復 6# seemee
Q1: 從4#這段程式碼裡得知
  1. 10.           xlData = DateAdd("m", -i, DateSerial(.[b1] + 1911, .[b2], 1))
  2. 11.            Myear = Year(xlData) - 1911 '民國年
  3. 12.            Mmon = Format(Month(xlData), "00")
複製代碼
Q2 :沒有Destination  那怎麼知道 ResultRange 要放哪裡?
從4#這段程式碼裡得知 是已存在外部查詢 ,不須指定Destination　
  1. 07.        Set Q(1) = .QueryTables(1)

  3. 08.        Set Q(2) = .QueryTables(2)
複製代碼
回復 7# seemee
這裡有答案
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

seemee

帖子
93 
主題
15 
精華
0 
積分
111 
點名
0  
作業系統
win7 
軟體版本
Office 2010 X86 
閱讀權限
20 
性別
男 
註冊時間
2012-7-3 
最後登錄
2020-12-3 
9#
發表於 2013-5-19 23:52 | 只看該作者
本帖最後由 seemee 於 2013-5-19 23:55 編輯

回復 8# GBKEE
我還是不太懂問題
1.  ?myear=101&mmon=04 我指的是怎麼知道要加這些 網頁上的網址沒有顯示
2. 加權歷史行情.rar (15.27 KB) 沒有加Destination　 但是他的外部資料暫存是在U欄開始 是預設從U欄開始嗎?
    個股歷史行情TEST1.rar (37.03 KB)    如果資料範圍超過U欄 會造成資料重疊 而錯誤


謝謝版主的耐心回答

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 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欄, 請比對 [加權歷史行情] 相對的程式碼 複製到的位置在哪裡?
  1. With Q(2)  '個股歷史行情TEST1T程式碼
  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
  3.                 Q(2).WebTables = "8"
  4.                 Q(2).Refresh BackgroundQuery:=False
  5.                 .ResultRange.Offset(2).Copy .Parent.Cells(Rows.Count, "S").End(xlUp).Offset(1)
  6.             End With
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 人生不一定球球是好球，但是有歷練的強打者，隨時都可以揮棒。
12
返回列表 上一主題