標題: [發問] 網頁資料無法下載成功 [打印本頁]

---

作者: chingmac    時間: 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    時間: 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

複製代碼

---

作者: chingmac    時間: 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行的時候，卻出現"程序呼叫或引數不正確"，找了很久，還是不知道問題出在哪裡

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

---

作者: joey0415    時間: 2014-11-30 10:41

本帖最後由 joey0415 於 2014-11-30 10:44 編輯

回復 3# chingmac

完全沒有題哦！

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

第一頁放股票代碼

第二頁執行

1. Sub ex()
   
2. 
   
3. Worksheets(2).Activate
   
4. Worksheets(2).Cells.Delete
   
5. For i = 1 To 20
   
6.     sname = Worksheets(1).Cells(i, 1)
   
7. 
   
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
    
17. 
    
18. 
    
19. End Sub

複製代碼

---

作者: GBKEE    時間: 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

---

作者: chingmac    時間: 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大大，這組程式碼到底在哪裡出了問題呢？感謝幫忙！！

---

作者: chingmac    時間: 2014-11-30 23:50

回復 5# GBKEE

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

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

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

---

作者: GBKEE    時間: 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

複製代碼

---

作者: chingmac    時間: 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

複製代碼

我把執行的結果畫了一張略圖如下

[attach]19683[/attach]

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

---

作者: chingmac    時間: 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

複製代碼

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)