返回列表 上一主題 發帖

[發問] 網頁資料無法下載成功

chingmac

帖子
10 
主題
2 
精華
0 
積分
12 
點名
0  
作業系統
win7 
軟體版本
office2003或2010 
閱讀權限
10 
性別
男 
註冊時間
2014-11-20 
最後登錄
2014-12-24 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2014-11-29 23:26 | 只看該作者

[發問] 網頁資料無法下載成功

最近需要將某個網頁的資料運用到excel檔中，卻發現不能利用excel"資料"-->"匯入外部資料"-->"新增web查詢"的方式直接匯入

會出現"此web查詢沒有回傳資料"的提示，爬文後發現可以用VBA來匯入

我需要抓取的財務資料網址如下

http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr0_2891.djhtm

但是小弟學藝不精，雖然有找到GBKEE大大指導其他人的程式碼(http://forum.twbts.com/viewthread.php?tid=7586)

但直接修改程式碼的內容之後，仍只能顯示第一行資料就會出現錯誤"沒有設定物件變數或With區塊變數"

程式碼如下
  1. Sub Ex()
  2.     Dim xlVbTable As Object, Ar, R As Integer, C As Integer
  3.     With CreateObject("InternetExplorer.Application")
  4.         .Visible = True
  5.        .Navigate "http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr0_2891.djhtm"
  6.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  7.         Set xlVbTable = .document.getelementsbytagname("table")(11)
  8.         Ar = Split(xlVbTable.Rows(0).Cells(0).innerText, Chr(10))(1)
  9.         With ActiveSheet
  10.             .Cells(1, 1) = Mid(Ar, 1, InStr(Ar, ":"))
  11.             .Cells(1, 2) = Mid(Ar, InStr(Ar, ":") + 1, 9)
  12.             For R = 1 To xlVbTable.Rows.Length - 1
  13.                 For C = 0 To xlVbTable.Rows(1).ALL.Length - 1
  14.                     .Cells(R + 1, C + 1) = xlVbTable.Rows(R).Cells(C).innerText
  15.                 Next
  16.             Next
  17.         End With
  18.        .Quit
  19.     End With
  20. End Sub
複製代碼
不知道GBKEE大大能否幫忙看一下

感恩
收藏 分享

joey0415
　暱稱: joey0415

中學生Rank: 2

帖子
361 
主題
57 
精華
0 
積分
426 
點名
0  
作業系統
win7 
軟體版本
2003,2010 
閱讀權限
20 
性別
男 
註冊時間
2010-5-13 
最後登錄
2022-12-8 
2#
發表於 2014-11-30 00:05 | 只看該作者
可以哦！

剩下的自己改

回復 1# chingmac
  1. Sub ex()
  2.     With ActiveSheet.QueryTables.Add(Connection:= _
  3.         "URL;http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr0_2891.djhtm", Destination:=Range("A1"))
  4.         .WebFormatting = xlWebFormattingNone
  5.         .Refresh BackgroundQuery:=False
  6.         .Delete
  7.     End With
  8. End Sub
複製代碼

TOP

chingmac

帖子
10 
主題
2 
精華
0 
積分
12 
點名
0  
作業系統
win7 
軟體版本
office2003或2010 
閱讀權限
10 
性別
男 
註冊時間
2014-11-20 
最後登錄
2014-12-24 
3#
發表於 2014-11-30 01:31 | 只看該作者
回復 2# joey0415


感謝joey0415大大的熱心幫忙，程式碼執行成功！

但現在出現了另一個問題，因為其實我已經將想下載的股票代碼輸入至另一個sheet裡面(例如是sheet2的B3到B5)

修改後的程式碼如下
  1. Sub ex()
  2.     Dim Webpage As String
  3.     Row = 3
  4.     Do While Worksheets("sheet2").Cells(Row, 2).Value <> ""
  5.             Webpage = "http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr0_" & Worksheets("sheet2").Cells(Row, 2).Value & ".djhtm"
  6.             With ActiveSheet.QueryTables.Add(Connection:= _
  7.             "URL;Webpage", Destination:=Range("A1"))
  8.             .WebFormatting = xlWebFormattingNone
  9.             .Refresh BackgroundQuery:=False
  10.             .Delete
  11.             End With
  12.             Row = Row + 1
  13.     Loop
  14. End Sub
複製代碼
本來的想法是設定一個Webpage變數儲存網址，利用監看式也發現該變數值是如我所要的

可是到了要執行第5行的時候，卻出現"程序呼叫或引數不正確"，找了很久，還是不知道問題出在哪裡

可否請教各位大大協助修改，或者有更好的寫法，感謝！

TOP

joey0415
　暱稱: joey0415

中學生Rank: 2

帖子
361 
主題
57 
精華
0 
積分
426 
點名
0  
作業系統
win7 
軟體版本
2003,2010 
閱讀權限
20 
性別
男 
註冊時間
2010-5-13 
最後登錄
2022-12-8 
4#
發表於 2014-11-30 10:41 | 只看該作者
本帖最後由 joey0415 於 2014-11-30 10:44 編輯

回復 3# chingmac

完全沒有題哦！

我花不到十秒就完成二十檔了

第一頁放股票代碼

第二頁執行
  1. Sub ex()

  3. Worksheets(2).Activate
  4. Worksheets(2).Cells.Delete
  5. For i = 1 To 20
  6.     sname = Worksheets(1).Cells(i, 1)

  8.     With ActiveSheet.QueryTables.Add(Connection:= _
  9.         "URL;http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr0_" & sname & ".djhtm", Destination:=Range("A1"))
  10.         .WebFormatting = xlWebFormattingNone
  11.         .Refresh BackgroundQuery:=False
  12.         .Delete
  13.     End With
  14.     'Worksheets(2).Cells.Delete
  15.    
  16. Next


  19. End Sub
複製代碼

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#
發表於 2014-11-30 19:21 | 只看該作者
回復 1# chingmac
Rows(1) 改成 -> Rows(R)

For R = 1 To xlVbTable.Rows.Length - 1
     For C = 0 To xlVbTable.Rows(1).ALL.Length - 1
             .Cells(R + 1, C + 1) = xlVbTable.Rows(R).Cells(C).innerText
     Next
Next
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

chingmac

帖子
10 
主題
2 
精華
0 
積分
12 
點名
0  
作業系統
win7 
軟體版本
office2003或2010 
閱讀權限
10 
性別
男 
註冊時間
2014-11-20 
最後登錄
2014-12-24 
6#
發表於 2014-11-30 23:40 | 只看該作者
回復 4# joey0415

再次感謝joey0415大大的熱心幫忙！從您的程式碼內發現原來在我之前修改的程式碼內，我不需要設定一個Webpage變數來存放網址

直接用Num當股票代碼的變數，把URL後面的網址寫為http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr_" & Num & ".djhtm就行了

可是在執行第一支股票3474的時候發現，http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr_3474.djhtm的網頁內並無該支股票的資料

反而要到http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr0_3474.djhtm這個網頁才有我要的資料

結果現在變成要處理兩種情形，若第一種網頁有我要的資料就直接匯入，如果沒有，就改匯第二種網頁

我的想法是不管如何都先下載第一種網頁，再利用IF語法判斷，若在B4儲存格內出現"查無"的字串，就再匯入第二種網頁

否則不進行任何動作，直接跳下一支股票，程式碼如下：
  1. Sub ex()
  2.     Dim Num As String
  3.     Row = 5
  4.     Worksheets("股東權益報酬率").Activate
  5.     Do While Worksheets("台灣50成分股").Cells(Row, 2).Value <> ""
  6.         Num = Worksheets("台灣50成分股").Cells(Row, 2).Value
  7.         With ActiveSheet.QueryTables.Add(Connection:= _
  8.             "URL;http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr_" & Num & ".djhtm", Destination:=Range("A1"))
  9.             .WebFormatting = xlWebFormattingNone
  10.             .Refresh BackgroundQuery:=False
  11.             .Delete
  12.         End With
  13.         Set myRange = Worksheets("股東權益報酬率").Range("B4")
  14.         If (Application.WorksheetFunction.IsError(Application.WorksheetFunction.Search("查無", myRange)) = False ) Then
  15.             Range("B1:C50").Delete
  16.             With ActiveSheet.QueryTables.Add(Connection:= _
  17.             "URL;http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr0_" & Num & ".djhtm", Destination:=Range("A1"))
  18.             .WebFormatting = xlWebFormattingNone
  19.             .Refresh BackgroundQuery:=False
  20.             .Delete
  21.             End With
  22.         End If
  23.         Row = Row + 1
  24.         Num = ""
  25.     Loop
  26. End Sub
複製代碼
結果問題又出現了，第一支股票3474很順利地經由IF語法判斷須再次匯入第二種網頁，也正常匯入，可是第二支股票4938，卻在IF的判斷式中跳出錯誤訊息

執行階段錯誤'1004'   應用程式或物件上的定義錯誤

可是我把那段IF內的邏輯判斷式Application.WorksheetFunction.IsError(Application.WorksheetFunction.Search("查無", myRange))

改成ISERROR(SEARCH("期", 股東權益報酬率!B4))後，放在工作表內卻是可以正常執行的，顯現True或False的

想再請問joey0415大大，這組程式碼到底在哪裡出了問題呢？感謝幫忙！！

TOP

chingmac

帖子
10 
主題
2 
精華
0 
積分
12 
點名
0  
作業系統
win7 
軟體版本
office2003或2010 
閱讀權限
10 
性別
男 
註冊時間
2014-11-20 
最後登錄
2014-12-24 
7#
發表於 2014-11-30 23:50 | 只看該作者
回復 5# GBKEE

感謝GBKEE超板的幫忙，之前的問題大致上已經解決了，只剩下6#所描述的問題，不知道您有何解法？

雖然不是使用您之前所提供的，但還是要感謝您願意花時間協助，感恩！

不管是您或joey0415大大寫的，都是我要去把它們研究清楚的，原來一樣的目的卻可以有截然不同的寫法，看來我要學的東西還真不少！

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#
發表於 2014-12-1 08:01 | 只看該作者
回復 7# chingmac
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Num As String, Row As Integer
  4.     Row = 5
  5.     With Worksheets("股東權益報酬率") '.Activate
  6.     '  Do While Worksheets("台灣50成分股").Cells(Row, 2).Value <> ""
  7.         'Num = Worksheets("台灣50成分股").Cells(Row, 2).Value
  8.         Num = 3474
  9.         With .QueryTables.Add(Connection:= _
  10.             "URL;http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr_" & Num & ".djhtm", Destination:=Range("A1"))
  11.             .WebFormatting = xlWebFormattingNone
  12.             .Refresh BackgroundQuery:=False
  13.             .Delete
  14.         End With
  15.         If .Range("B4") Like "查無*資料" Then
  16.             With .QueryTables.Add(Connection:= _
  17.                 "URL;http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr0_" & Num & ".djhtm", Destination:=Range("A1"))
  18.                 .WebFormatting = xlWebFormattingNone
  19.                 .Refresh BackgroundQuery:=False
  20.                 .Delete
  21.             End With
  22.         End If
  23.        ' Row = Row + 1
  24.    ' Loop
  25.    End With
  26. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

chingmac

帖子
10 
主題
2 
精華
0 
積分
12 
點名
0  
作業系統
win7 
軟體版本
office2003或2010 
閱讀權限
10 
性別
男 
註冊時間
2014-11-20 
最後登錄
2014-12-24 
9#
發表於 2014-12-1 19:59 | 只看該作者
回復 8# GBKEE

再次感謝GBKEE超板的幫忙，刪除您的第八行程式跟符號 ' 之後(我猜您應該是測試程式的時候使用的)，程式執行又出了問題

這次不是程式的錯誤，我覺得應該是Excel的限制

大約執行到第29支股票的時候，程式就出現"執行階段錯誤'1004'   應用程式或物件上的定義錯誤"的訊息

查看跑出來的結果後，發現工作表只能跑到第IV行就出現錯誤了，想要再加上一行都不行了，所以應該是Excel的限制

因此我想讓程式在跑完10支股票之後，在最上面插入45列(因為資料的範圍是固定的)，把前10支的資料從擠到第47列之後

讓第11到20支股票再從B2開始匯入。但是沒想到，網頁匯入的方式好像是以整行的方式匯入，除了第11支乖乖地剛好在第10支的上方以外

12到20支的資料匯入時，會以整行的方式將現有資料全部往右移，不是我本來想像的只將第11支的資料往右移而已

我目前寫到的程式碼如下
  1. Sub ex()
  2.     Dim Num As String
  3.     Row = 5
  4.     Worksheets("股東權益報酬率").Activate
  5.     Cells.ClearContents
  6.     N = 0
  7.     Do While Worksheets("台灣50成分股").Cells(Row, 2).Value <> ""
  8.         Num = Worksheets("台灣50成分股").Cells(Row, 2).Value
  9.         With ActiveSheet.QueryTables.Add(Connection:= _
  10.         "URL;http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr_" & Num & ".djhtm", Destination:=Range("A1"))
  11.         .WebFormatting = xlWebFormattingNone
  12.         .Refresh BackgroundQuery:=False
  13.         .Delete
  14.         End With
  15.         If (Worksheets("股東權益報酬率").Cells(4, 2) Like "查無*資料") Then
  16.             Columns(2).Select
  17.             Selection.ClearContents
  18.             With ActiveSheet.QueryTables.Add(Connection:= _
  19.             "URL;http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr0_" & Num & ".djhtm", Destination:=Range("A1"))
  20.             .WebFormatting = xlWebFormattingNone
  21.             .Refresh BackgroundQuery:=False
  22.             .Delete
  23.             End With
  24.         End If
  25.         N = N + 1
  26.         If (N / 10 = Int(N / 10) And N < 50) Then
  27.            Rows("2:46").Insert Shift:=xlDown
  28.         End If
  29.         Row = Row + 1
  30.         Num = ""
  31.     Loop
  32. End Sub
複製代碼
我把執行的結果畫了一張略圖如下



不知要怎麼修改比較好？有辦法讓網頁匯入的時候不要以整行的方式將所有資料向右移嗎？感謝各位的幫忙！

TOP

chingmac

帖子
10 
主題
2 
精華
0 
積分
12 
點名
0  
作業系統
win7 
軟體版本
office2003或2010 
閱讀權限
10 
性別
男 
註冊時間
2014-11-20 
最後登錄
2014-12-24 
10#
發表於 2014-12-2 14:04 | 只看該作者
回復 9# chingmac

真的非常感謝GBKEE超板跟joey0415大大的熱心幫忙，把我要的程式碼修改完成了，#9的問題因為Excel的限制及網頁匯入格式的關係

最後把程式修改成直行匯入的形式，由上往下匯入每支股票，先匯入的股票不會因為後面股票的匯入而產生位移的情形，也不會有不夠的問題

(office2003工作表最多可以有65536列)，經過測試，終於出現需要的資料了，程式碼如下，給有類似需要的人做參考！
  1. Sub ex()
  2.     Dim Num As String
  3.     R = 5
  4.     Worksheets("股東權益報酬率").Activate
  5.     Cells.ClearContents
  6.     N = 0
  7.     Do While Worksheets("台灣50成分股").Cells(R, 2).Value <> ""
  8.         Row = N * 48 + 1
  9.         Num = Worksheets("台灣50成分股").Cells(R, 2).Value
  10.         With ActiveSheet.QueryTables.Add(Connection:= _
  11.         "URL;http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr_" & Num & ".djhtm", Destination:=Range("A" & Row))
  12.         .WebFormatting = xlWebFormattingNone
  13.         .Refresh BackgroundQuery:=False
  14.         .Delete
  15.         End With
  16.         If (Worksheets("股東權益報酬率").Cells(Row + 3, 2) Like "查無*資料") Then
  17.             Range(Cells(Row, "A"), Cells(Row + 45, "C")).Select
  18.             Selection.ClearContents
  19.             With ActiveSheet.QueryTables.Add(Connection:= _
  20.             "URL;http://jsjustweb.jihsun.com.tw/z/zc/zcr/zcr0_" & Num & ".djhtm", Destination:=Range("A" & Row))
  21.             .WebFormatting = xlWebFormattingNone
  22.             .Refresh BackgroundQuery:=False
  23.             .Delete
  24.             End With
  25.         End If
  26.         R = R + 1
  27.         N = N + 1
  28.         Num = ""
  29.     Loop
  30. End Sub
複製代碼

TOP

        靜思自在 : 有時當思無時苦，好天要積雨來糧。
返回列表 上一主題