12345
返回列表 上一主題 發帖

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

bioleon69
　暱稱: 小B

中學生Rank: 2

帖子
62 
主題
14 
精華
0 
積分
86 
點名
0  
作業系統
win10 
軟體版本
offffice2013 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2016-8-23 
最後登錄
2017-11-5 

論壇贊助勳章
37# 跳轉到 »
發表於 2017-5-13 12:11 | 只看該作者
回復 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

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

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

TOP

bioleon69
　暱稱: 小B

中學生Rank: 2

帖子
62 
主題
14 
精華
0 
積分
86 
點名
0  
作業系統
win10 
軟體版本
offffice2013 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2016-8-23 
最後登錄
2017-11-5 

論壇贊助勳章
36#
發表於 2017-5-8 06:04 | 只看該作者
本帖最後由 bioleon69 於 2017-5-8 06:05 編輯

回復 35# GBKEE


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

感謝GBK大!

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
35#
發表於 2017-5-8 05:53 | 只看該作者
回復 33# bioleon69
  1. Option Explicit
  2. Sub 測試()
  3.     Dim oXmlhttp As Object, oHtmldoc As Object, surl, E As Object
  4.     Set oXmlhttp = CreateObject("msxml2.xmlhttp")
  5.     Set oHtmldoc = CreateObject("htmlfile")
  6.     surl = "http://mops.twse.com.tw/nas/t21/sii/t21sc03_106_3_0.html"
  7.     With oXmlhttp
  8.         .Open "Get", surl, False
  9.         .Send
  10.         'oHtmldoc.write .responseText
  11.         oHtmldoc.write BinToStr(.responseBody, "BIG5") '網頁編碼 "中文"
  12.     End With
  13.     With oHtmldoc
  14.         Set E = .all.tags("TABLE")(3)
  15.     End With
  16.     Application.ScreenUpdating = False
  17.     Ex_副程式 E
  18.     Application.ScreenUpdating = True
  19. End Sub
  20. Private Sub Ex_副程式(A As Object)
  21.     Dim i As Integer, R As Integer, C As Integer
  22.     With ActiveSheet    '可指定工作表
  23.         .UsedRange.Clear
  24.         For R = 0 To A.Rows.Length - 1
  25.                 For C = 0 To A.Rows(R).Cells.Length - 1
  26.                     .Cells(R + 1, C + 1) = A.Rows(R).Cells(C).innertext
  27.                 Next
  28.         Next
  29.         With .UsedRange  ' CELL 為整工作表的儲存格 範圍大(費時)
  30.            ' .UsedRange 工作表有使用到的的儲存格 範圍小(省時)
  31.             .EntireRow.AutoFit
  32.             .EntireColumn.AutoFit
  33.         End With
  34.     End With
  35. End Sub
  36. Function BinToStr(arrBin, strChrs) As String
  37.     With CreateObject("ADODB.Stream")  '二進位文檔,傳送,儲存
  38.         .Type = 2
  39.         .Open
  40.         .Writetext arrBin
  41.         .Position = 0
  42.         .Charset = strChrs   '指定編碼
  43.         BinToStr = .ReadText
  44.         .Close
  45.     End With
  46. End Function
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
34#
發表於 2017-5-4 08:28 | 只看該作者
回復 33# bioleon69

可改用會入外部資料 .QueryTables
  1. Option Explicit
  2. Sub Ex()
  3.     With ActiveSheet.QueryTables.Add(Connection:="URL;http://mops.twse.com.tw/nas/t21/sii/t21sc03_106_3_0.html", Destination:=Range("A1"))
  4.         .WebSelectionType = xlSpecifiedTables
  5.         .WebFormatting = xlWebFormattingNone
  6.         .WebTables = "4"
  7.         .RefreshStyle = xlOverwriteCells
  8.         .WebPreFormattedTextToColumns = True
  9.         .WebConsecutiveDelimitersAsOne = True
  10.         .WebSingleBlockTextImport = False
  11.         .WebDisableDateRecognition = False
  12.         .WebDisableRedirections = False
  13.         .Refresh BackgroundQuery:=False
  14.     End With
  15. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

bioleon69
　暱稱: 小B

中學生Rank: 2

帖子
62 
主題
14 
精華
0 
積分
86 
點名
0  
作業系統
win10 
軟體版本
offffice2013 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2016-8-23 
最後登錄
2017-11-5 

論壇贊助勳章
33#
發表於 2017-5-3 06:34 | 只看該作者
本帖最後由 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
　暱稱: 小B

中學生Rank: 2

帖子
62 
主題
14 
精華
0 
積分
86 
點名
0  
作業系統
win10 
軟體版本
offffice2013 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2016-8-23 
最後登錄
2017-11-5 

論壇贊助勳章
32#
發表於 2017-5-1 21:38 | 只看該作者
本帖最後由 bioleon69 於 2017-5-1 21:40 編輯

回復 31# GBKEE


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

THX G大!

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
31#
發表於 2017-5-1 15:56 | 只看該作者
回復 30# bioleon69
  1. ''CreateObject("InternetExplorer.Application") 需等候網頁下載完畢速度較慢
  2. '執行迴圈讓它跑1500次,嘿速度會慢許多
  3. Option Explicit
  4. Sub 測試()
  5.     Dim oXmlhttp As Object, oHtmldoc As Object, surl, E As Object
  6.     Set oXmlhttp = CreateObject("msxml2.xmlhttp")
  7.     Set oHtmldoc = CreateObject("htmlfile")
  8.     surl = "http://norway.twsthr.info/StockHolders.aspx?stock=2330"
  9.     With oXmlhttp
  10.         .Open "Get", surl, False
  11.         .Send
  12.         oHtmldoc.write .responseText
  13.     End With
  14.     With oHtmldoc
  15.         Set E = .all.tags("TABLE")(9)
  16.     End With
  17.     Application.ScreenUpdating = False
  18.     Ex_副程式 E
  19.     Application.ScreenUpdating = True
  20. End Sub
  21. Private Sub Ex_副程式(A As Object)
  22.     Dim i As Integer, R As Integer, C As Integer
  23.     With ActiveSheet    '可指定工作表
  24.         .UsedRange.Clear
  25.         For R = 0 To 2 * 5    '讀取5筆資料 ' 雙數的A.Rows為空白資料
  26.             If R <= 1 Or R > 2 And R Mod 2 = 1 Then '剔除 雙數的A.Rows
  27.                 i = i + 1
  28.                 For C = 2 To A.Rows(R).Cells.Length - 1
  29.                     .Cells(i, C - 1) = A.Rows(R).Cells(C).innertext
  30.                 Next
  31.             End If
  32.         Next
  33.         With .UsedRange  ' CELL 為整工作表的儲存格 範圍大(費時)
  34.            ' .UsedRange 工作表有使用到的的儲存格 範圍小(省時)
  35.             .EntireRow.AutoFit
  36.             .EntireColumn.AutoFit
  37.         End With
  38.     End With
  39. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

bioleon69
　暱稱: 小B

中學生Rank: 2

帖子
62 
主題
14 
精華
0 
積分
86 
點名
0  
作業系統
win10 
軟體版本
offffice2013 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2016-8-23 
最後登錄
2017-11-5 

論壇贊助勳章
30#
發表於 2017-5-1 10:22 | 只看該作者
本帖最後由 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

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

TOP

bioleon69
　暱稱: 小B

中學生Rank: 2

帖子
62 
主題
14 
精華
0 
積分
86 
點名
0  
作業系統
win10 
軟體版本
offffice2013 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2016-8-23 
最後登錄
2017-11-5 

論壇贊助勳章
29#
發表於 2017-4-30 22:19 | 只看該作者
本帖最後由 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

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






  29.     End With
  30.     ie.Quit
  31. End Sub
複製代碼
懇請GBK大幫忙指點12...

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
28#
發表於 2015-9-14 06:12 | 只看該作者
本帖最後由 GBKEE 於 2015-9-14 06:14 編輯

回復 28# aaron1059
試試看
幫你找出傳回期權資料的網址不一樣.
  1. Option Explicit
  2. Sub Ex() 'Yahoo!奇摩股市--期權
  3.     Dim ie As Object, k As Integer, S As Integer, jj As Integer, i As Integer, AA As Object
  4.     Set ie = CreateObject("InternetExplorer.Application")
  5.     ie.Navigate "https://tw.screener.finance.yahoo.net/future/aa03?opmr=optionfull&opcm=WTFO&opym=201510&random=0.01296169775357775"
  6.     ie.Visible = True
  7.     Do While ie.Busy Or ie.ReadyState <> 4: DoEvents: Loop
  8.     Set AA = ie.Document.getelementsbytagname("table")
  9.     With Sheets(1)
  10.         .Cells.Clear
  11.         k = k + 1
  12.         For S = 0 To AA.Length - 1                 '已找出網頁的table內容在 5-7 中
  13.             For i = 0 To AA(S).Rows.Length - 1                 '資料的列位
  14.                 For jj = 0 To AA(S).Rows(i).Cells.Length - 1   '資料的欄位
  15.                     .Cells(k, jj + 1) = AA(S).Rows(i).Cells(jj).INNERTEXT
  16.                 Next
  17.                 k = k + 1
  18.              Next
  19.           Next
  20.        End With
  21.      ie.Quit
  22. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 閒人無樂趣，忙人無是非。
12345
返回列表 上一主題