返回列表 上一主題 發帖

[發問] 一個用VBA從網頁取得想要資料的寫法~

本帖最後由 bioleon69 於 2017-4-30 22:24 編輯

GBK大 請教一下
從上面爬文練習,目前可以從EXCEL叫出瀏覽器
之後要怎麼讀取網頁內容,內容寫入EXCEL
A3開始寫入
這邊真的卡住了..
以下是目前程式碼的進度
  1. Option Explicit
  2. Dim ie As Object
  3. Sub 集保()
  4.     Dim keyin As String
  5.     keyin = Range("a1")
  6.     Set ie = CreateObject("InternetExplorer.Application")
  7.       With ie
  8.          .Navigate "http://norway.twsthr.info/StockHolders.aspx?stock=" & keyin & ""
  9.          .Visible = True
  10.          Do While ie.Busy Or ie.readyState <> 4: DoEvents: Loop
  11.      End With
  12. Ex_副程式
  13. End Sub

  14. Private Sub Ex_副程式()
  15.     Dim A As Object
  16.     With ie
  17.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  18.         Set A = .Document.getElementsByTagName("table")
  19.     End With
  20.     With ActiveSheet    '可指定工作表
  21.         .UsedRange.Clear






  22.     End With
  23.     ie.Quit
  24. End Sub
複製代碼
懇請GBK大幫忙指點12...

TOP

本帖最後由 bioleon69 於 2017-5-1 10:27 編輯

目前成功可執行了,也多虧版上許多資源
有幾個問題想請教





請問一下
1.為什麼我執行出來後會有空白的列?
是哪邊出了什麼狀況?



2.可以把寫入excel的資料,定義成一個東西嗎
可以用with  end with來控制內容(只控制寫入的部分)
比方說字體大小,寬度高度,上色,刪除/清除,等等
不會牽動到周圍的資料

3.目前程式碼還可優化嗎?
因為想要再弄一個迴圈執行後讓它跑1500次
這程式碼會不會很吃系統資源?(怕電腦lag)

感謝
以下程式碼
  1. Option Explicit
  2. Dim ie As Object
  3. Sub 測試()
  4.   Set ie = CreateObject("InternetExplorer.Application")
  5.     With ie
  6.         .Navigate "http://norway.twsthr.info/StockHolders.aspx?stock=2330"
  7.         .Visible = True
  8.         Do While ie.Busy Or ie.readyState <> 4: DoEvents: Loop
  9.     End With
  10.     UsedRange.Clear
  11.     Ex_副程式
  12. End Sub

  13. Private Sub Ex_副程式()
  14. Dim A, i, ii
  15.     With ie
  16.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  17.         Set A = .Document.getElementsByTagName("table")(9)
  18.     End With
  19.     With ActiveSheet    '可指定工作表
  20.    
  21.         For i = 0 To A.Rows.Length - 296
  22.             For ii = 3 To A.Rows(i).Cells.Length - 1
  23.            .Cells(i + 1, ii - 2) = A.Rows(i).Cells(ii).innertext
  24.             Next
  25.             Next
  26.     With Cells
  27.             .EntireRow.AutoFit
  28.             .EntireColumn.AutoFit
  29.     End With
  30.     End With
  31.     ie.Quit
  32. End Sub
複製代碼
另外附上檔案
test.rar (16.05 KB)

TOP

本帖最後由 bioleon69 於 2017-5-1 21:40 編輯

回復 31# GBKEE


了解
對這兩個物件還很陌生
CreateObject("msxml2.xmlhttp")
CreateObject("htmlfile")
目前也幾乎都是抄寫G大留下的程式碼修改學習
趕緊來學習看看

THX G大!

TOP

本帖最後由 bioleon69 於 2017-5-3 06:35 編輯

兩個疑問
#亂碼
#全部表格的指定方法


http://mops.twse.com.tw/nas/t21/sii/t21sc03_106_3_0.html
如果是這個網頁
會變這樣



如果是要抓這網頁的全部表格內容
非單一指定表格

應該怎麼修改?
With oHtmldoc
        Set E = .all.tags("TABLE")(9)
End With

關鍵應該是這一行?後面打(0)會出現錯誤

求指導!感謝

TOP

本帖最後由 bioleon69 於 2017-5-8 06:05 編輯

回復 35# GBKEE


漂亮,目前在學著用XML啦
那個轉碼的漂亮,雖然不是很懂寫法
小弟只能先抄下來死背套用
論壇終於好了XDD

感謝GBK大!

TOP

回復 35# GBKEE

午安 G大

你的這個轉碼系統

如果是在QT的話,該怎麼呼叫?
謝謝您^^辛苦了

例如(以下)
  1. Sub 下載CSV()
  2. Set book1 = ActiveSheet
  3. Set bookshow = book1.QueryTables _
  4.     .Add(Connection:="TEXT;https://smart.tdcc.com.tw/opendata/getOD.ashx?id=2-8", _
  5.         Destination:=book1.Range("a1"))
  6. With bookshow

  7.     .TextFileParseType = xlDelimited
  8.   .TextFileCommaDelimiter = True
  9.     .Refresh
  10. End With

  11. End Sub
複製代碼
VBA 從0開始
先從學會看的懂開始
先從會有基本修改能力開始
一步一步學習中

TOP

本帖最後由 bioleon69 於 2017-5-13 15:16 編輯

回復 37# bioleon69


GGGG大..還有一個問題..
(拍謝,讓G大最近很忙 哈哈!)

我一個一個測試,應該是第12個表格沒有錯
為什麼會下載不了呢??奇怪
  1. Sub TEST()
  2.     With ActiveSheet.QueryTables.Add(Connection:="URL;http://mops.twse.com.tw/mops/web/t56sb21_q3?encodeURIComponent=1&run=Y&step=1&TYPEK=sii&year=105&smonth=01&emonth=02&sstep=1&firstin=true", Destination:=Range("A1"))
  3.         .Name = "上市持股轉讓"
  4.         .WebFormatting = xlWebFormattingNone
  5.         .WebTables = "12"
  6.         .RefreshStyle = xlOverwriteCells
  7.         .WebPreFormattedTextToColumns = True
  8.         .WebConsecutiveDelimitersAsOne = True
  9.         .WebDisableDateRecognition = False
  10.         .Refresh BackgroundQuery:=False
  11.     End With
  12. End Sub
複製代碼
VBA 從0開始
先從學會看的懂開始
先從會有基本修改能力開始
一步一步學習中

TOP

回復 39# GBKEE


要用ie的方法嗎??
煩請大大幫忙看一下程式碼哪邊有問題,我寫的那兩行都不能按下去
  1. Sub test()
  2. Dim ie, ab, cc
  3.     Set ie = CreateObject("InternetExplorer.Application")
  4.     With ie
  5.          .Visible = True
  6.         .navigate "http://mops.twse.com.tw/mops/web/t56sb21_q3"
  7.         Do Until .ReadyState = 4
  8.             DoEvents
  9.         Loop
  10.         Set cc = .document
  11.         Set ab = .document.forms("form1")
  12.         ab.typek.Value = "otc"
  13.         ab.Year.Value = "105"
  14.         ab.smonth.Value = "03"
  15.         ab.emonth.Value = "04"
  16.         'cc.getelementbyid("search_bar1").Click
  17.        ' ab.submit
  18.         End With
  19. End Sub
複製代碼
VBA 從0開始
先從學會看的懂開始
先從會有基本修改能力開始
一步一步學習中

TOP

本帖最後由 bioleon69 於 2017-5-15 17:16 編輯

回復 41# GBKEE
G大,第一段程式的FOR EACH那邊確實可以模擬點擊
小弟先收下了!!
---------------------
第一段(test)的應該是您回應我如何模擬點擊吧
以這個例子而言,似乎沒辦法從主搜尋網址
http://mops.twse.com.tw/mops/web/t56sb21_q3
模擬點擊後,直接在抓下面的table資料
而必須從
http://mops.twse.com.tw/mops/web/t56sb21_q3?encodeURIComponent=1&run=Y&step=1&TYPEK=sii&year=105&smonth=01&emonth=02&sstep=1&firstin=true
去抓資料
之後的第二段(ex)跟第三段(資料寫入)才是一個網抓對吧?(小弟理解)

---------------------

Private Sub 資料寫入(ByVal xTable As Object)
這個byval不是很懂,為何不直接dim到sub裡面?

以下是小弟自己最大理解能力的寫法,也是沒辦法成功寫入
還請G大幫忙指正一下錯誤,謝謝您^^"
  1. Sub test()
  2. '*****************************************
  3. Dim Ie
  4.     Set Ie = CreateObject("InternetExplorer.Application")
  5.     With Ie
  6.        'Visible = True
  7.         .Navigate "http://mops.twse.com.tw/mops/web/t56sb21_q3?encodeURIComponent=1&run=Y&step=1&TYPEK=sii&year=105&smonth=01&emonth=02&sstep=1&firstin=true"
  8.         Do Until .readyState = 4
  9.             DoEvents
  10.         Loop
  11. '*****************************************
  12.         Set cc = .Document.body
  13.         Set tb = cc.all.tags("table")(0).Rows '定義表格為陣列
  14.         'Debug.Print tb.innertext              '除錯用
  15. '*****************************************
  16.          With ActiveSheet
  17.         .UsedRange.Clear
  18.         For i = 0 To tb.Length - 1
  19.         For j = 0 To tb(i).Cells.Length - 1
  20.         .Cells(i + 1, j + 1) = tb(i).Cells(j).innertext '逐一寫入
  21.         Next
  22.         Next
  23.         End With
  24.     End With
  25.     Ie.Quit
  26.     Set Ie = Nothing
  27. End Sub
複製代碼
VBA 從0開始
先從學會看的懂開始
先從會有基本修改能力開始
一步一步學習中

TOP

回復 43# GBKEE

ok了!謝謝g大 愛您~^^


byval目前就先不考慮了= =||
VBA 從0開始
先從學會看的懂開始
先從會有基本修改能力開始
一步一步學習中

TOP

        靜思自在 : 人事的艱難與琢磨,就是一種考驗。
返回列表 上一主題