彰化一整天的論壇

 找回密碼
 立即註冊
查看: 888|回復: 7

關於Excel錄製「連線網站擷取資料」的迴圈

[複製鏈接]
發表於 2016-6-8 17:08:26 | 顯示全部樓層 |閱讀模式
一整天您好:
請教一個問題
就是我用Excel去連線抓取資料,如下圖
01.jpg
抓取下來的結果如下圖
02.jpg
然後把這個動作用「錄製巨集」錄製起來,程式碼如下圖
03.jpg
因為要抓資料的網站有其規則,亦即網址最末都是四個數字的結合
於是接著就寫個迴圈去大量抓取,從0000到9999,當然不是每個網頁都有資料
但也有寫若無資料就跳下一筆
04.jpg
後來發現,跑個100筆還可以,但有時候跑超過1000筆就會當機
有一次會10000筆全跑完,但有時跑不到1000筆就當機,如下
05.jpg
然後就似乎不跑了,請問這個問題該如何解決
感謝您的回答

回復

使用道具 舉報

發表於 2016-6-9 15:23:38 | 顯示全部樓層
您好,
     方便上傳excel檔案,我幫你找看看.
回復 支持 反對

使用道具 舉報

 樓主| 發表於 2016-6-9 21:54:53 | 顯示全部樓層
感謝一整天大大
回復 支持 反對

使用道具 舉報

 樓主| 發表於 2016-6-10 13:44:47 | 顯示全部樓層
一整天您好:
要從0000到9999有一萬筆實在太多了,又不是每一筆都有值
於是我把有值的抓出來,共近900筆,放在附檔的worksheets("工作表3")
然後用把錄製連線web抓資料的程式用迴圈兜起來,也是一樣會有不穩的問題
有時候 for i = 1 to  100還可以
但 for i = 1 to 800有時候就會有問題,會當機,整個卡住沒有回應
麻煩一整天大大幫我看看
感謝感謝

請教的問題.xlsm

29.94 KB, 下載次數: 235

回復 支持 反對

使用道具 舉報

 樓主| 發表於 2016-6-10 18:59:08 | 顯示全部樓層
本帖最後由 鉛筆狗 於 2016-6-10 23:56 編輯

正在嘗試讀取網頁原始碼的方法
回復 支持 反對

使用道具 舉報

發表於 2016-6-11 09:10:03 | 顯示全部樓層
鉛筆狗 發表於 2016-6-10 13:44
一整天您好:
要從0000到9999有一萬筆實在太多了,又不是每一筆都有值
於是我把有值的抓出來,共近900筆, ...

您好,
     您只要在迴圈中加入doevents,就可以解決問題.
  1. Sub 巨集1()
  2. '
  3. ' 巨集1 巨集
  4. '

  5. Dim ws1, ws2, ws3 As Worksheet
  6. Dim i As Integer

  7. Set ws1 = Worksheets("工作表1")
  8. Set ws2 = Worksheets("工作表2")
  9. Set ws3 = Worksheets("工作表3")

  10. For i = 1 To 880


  11.     With ActiveSheet.QueryTables.Add(Connection:= _
  12.         "URL;http://norway.twsthr.info/StockHolders.aspx?stock=" & Worksheets("工作表3").Cells(i, 1).Value, Destination:= _
  13.         Range("$A$1"))
  14.         .Name = "StockHolders.aspx?stock=3105"
  15.         .FieldNames = True
  16.         .RowNumbers = False
  17.         .FillAdjacentFormulas = False
  18.         .PreserveFormatting = True
  19.         .RefreshOnFileOpen = False
  20.         .BackgroundQuery = True
  21.         .RefreshStyle = xlInsertDeleteCells
  22.         .SavePassword = False
  23.         .SaveData = True
  24.         .AdjustColumnWidth = True
  25.         .RefreshPeriod = 0
  26.         .WebSelectionType = xlSpecifiedTables
  27.         .WebFormatting = xlWebFormattingNone
  28.         .WebTables = "9"
  29.         .WebPreFormattedTextToColumns = True
  30.         .WebConsecutiveDelimitersAsOne = True
  31.         .WebSingleBlockTextImport = False
  32.         .WebDisableDateRecognition = False
  33.         .WebDisableRedirections = False
  34.         .Refresh BackgroundQuery:=False
  35.     End With

  36.     ws1.Rows("1:3").Copy (ws2.Rows(3 * i - 2 & ":" & 3 * i))
  37.     ws2.Cells(3 * i - 2, 2).Value = ws3.Cells(i, 1).Value
  38.     ws2.Rows(3 * i - 2).Interior.Color = vbYellow
  39.     ws1.Columns("A:O").ClearContents
  40.     ws1.Select
  41.    
  42.     DoEvents


  43. Next

  44.     ws2.Select
  45. End Sub

複製代碼


請教的問題.xlsm

549.83 KB, 下載次數: 264

回復 支持 反對

使用道具 舉報

發表於 2016-6-11 09:11:05 | 顯示全部樓層
鉛筆狗 發表於 2016-6-10 18:59
正在嘗試讀取網頁原始碼的方法

用這個方式執行時間比較快.
回復 支持 反對

使用道具 舉報

 樓主| 發表於 2016-6-11 11:11:21 | 顯示全部樓層
一整天大大您好
加個doevents真的可以,您真神...
我原本有在迴圈裡加個msgbox就能使全部都跑完
但就必須拿重物壓住 "Enter" 鍵使消除每次出現的msgbox (超笨...)
真是太感謝您了
回復 支持 反對

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)  |网站地图

GMT+8, 2019-9-19 15:13 , Processed in 0.138241 second(s), 21 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回復 返回頂部 返回列表