返回列表 上一主題 發帖

[發問] 請教網頁捉取的問題? CreateObject("msxml2.xmlhttp") 的問題?

本帖最後由 wufonna 於 2022-1-6 19:04 編輯

回復 1# wufonna

金融保險業 別 的表格格式不一樣 抓不到正確的資料
我是取
ROE=損益表-稅前淨利(67)/資產負債表股-東權益總額(95)
.Cells(i, 9).Value = 工作表4.Cells(67, 2).Value / 工作表5.Cells(95, 2).Value 'ROE%
求改正方法 謝謝

附檔是抓到的資料

GetDividend-2022-1-6.rar (230.62 KB)

TOP

回復 1# wufonna
  1. Sub test()
  2. Debug.Print "test"


  3. With Sheet1
  4.   Debug.Print .Columns("A").Find("稅前淨利").Row
  5.   Debug.Print .Range("b" & Sheet1.Columns("A").Find("稅前淨利").Row).Value
  6.   
  7.   Debug.Print .Rows("67").Find(-336).Column
  8.   Debug.Print .Rows("67").Find("-336").Column
  9.   Debug.Print .Rows("67").Find("52").Column
  10.             
  11.   Debug.Print .Rows("67").Find(0).Column '找到101內的0

  12. End With

  13. End Sub
複製代碼
紀錄一下

testest.rar (17.45 KB)

TOP

  1. '          .Cells(i, 9).Value = 工作表4.Cells(67, 2).Value / 工作表5.Cells(95, 2).Value 'ROE%
  2.            .Cells(i, 9).Value = 工作表4.Range("b" & 工作表4.Columns("A").Find("稅前淨利").Row).Value / 工作表5.Range("b" & 工作表5.Columns("A").Find("股東權益總額").Row).Value 'ROE% 不固定位子
複製代碼
回復 1# wufonna

修該片段

TOP

本帖最後由 GBKEE 於 2022-1-11 17:12 編輯

回復 7# wufonna
要了解網頁編碼,才能得心應手
  1. Private Sub GetIncome() '取損益表(年表)網頁
  2. Dim Url, HTMLsourcecode, GetXml, TableG, i, j
  3. Set HTMLsourcecode = CreateObject("htmlfile")
  4. Set GetXml = CreateObject("msxml2.xmlhttp")
  5. Url = "http://kgieworld.moneydj.com/z/zc/zcq/zcqa/zcqa_2330.djhtm"
  6. With GetXml
  7. .Open "GET", Url, False
  8. .Send
  9. HTMLsourcecode.body.innerhtml = .Responsetext
  10. Set TableG = HTMLsourcecode.getelementsbyclassname("table-row")
  11. '***網頁的編碼**********************************
  12. '<div class="table-row">   為所要的資料 的網頁元素
  13. '<span class="t2 table-cell">期別</span>
  14. '<span class="t2 table-cell">2020</span>
  15. '<span class="t2 table-cell">2019</span>
  16. '<span class="t2 table-cell">2018</span>
  17. '<span class="t2 table-cell">2017</span>
  18. '<span class="t2 table-cell">2016</span>
  19. '<span class="t2 table-cell">2015</span>
  20. '<span class="t2 table-cell">2014</span>
  21. '<span class="t2 table-cell">2013</span>
  22. '</div>************************************
  23. For i = 0 To TableG.Length - 1
  24.     For j = 0 To TableG(i).all.tags("span").Length - 1
  25.        Cells(i + 1, j + 1) = TableG(i).all.tags("span")(j).innertext
  26.     Next j
  27. Next i
  28. End With
  29. Set HTMLsourcecode = Nothing '釋放記憶體
  30. Set GetXml = Nothing
  31. End Sub '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
複製代碼
ROE=損益表-稅前淨利(67)/資產負債表股-東權益總額(95)
.Cells(i, 9).Value = 工作表4.Cells(67, 2).Value / 工作表5.Cells(95, 2).Value 'ROE%
#11 的問題這公式應可解決
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 GBKEE 於 2022-1-11 15:54 編輯

回復 11# wufonna
Pchome 的線型走勢 網頁  VBA 參考 看看
  1. Option Explicit
  2. Dim Rng As Range, 資訊_Msg As Boolean, ie As New InternetExplorer
  3. Sub AllFile()    '重新更新所有資料
  4.     Dim i As Integer
  5.     With Sheets("股票")
  6.         .UsedRange.CurrentRegion.Offset(0, 1).Clear
  7.         資訊_Msg = True
  8.         For i = 1 To .Range("A" & .Rows.Count).End(xlUp).Row
  9.             程式執行 Cells(i, 1)
  10.         Next
  11.         資訊_Msg = False
  12.         If 資訊_Msg = False Then ie.Quit
  13.     End With
  14. End Sub
  15. Sub ex()
  16.     程式執行 [B1]
  17. End Sub
  18. Private Sub 程式執行(xRng As Range)  '單筆更新 指定A欄的資料
  19.     If xRng.Column > 1 Then MsgBox xRng & " 不在 A欄": Exit Sub
  20.    ' If ie Is Nothing Then Set ie = New InternetExplorer
  21.     Set Rng = xRng
  22.     股票資訊
  23.     Rng.Select
  24.     If 資訊_Msg = False Then ie.Quit
  25. End Sub
  26. Sub 股票資訊()
  27.     Dim E As Object, Ar(), A As Integer, R As Integer, C As Integer
  28.     With Rng
  29.         A = .Parent.UsedRange.Columns.Count - 1
  30.         If 資訊_Msg = False Then
  31.         .Offset(, 1).Resize(, A).Select
  32.         .Offset(, 1).Resize(, A).Clear
  33.         End If
  34.         If .Row = 1 Then .Cells(1, 2) = "股票名稱 ": .Cells(1, 3) = "股票價格 "
  35.     End With
  36. On Error GoTo Beerr
  37. Be:
  38.     With ie
  39.     DoEvents
  40.         .Navigate "https://pchome.megatime.com.tw/stock/sid" & Rng & ".html" '
  41.        '   .Visible = True
  42.          Do While .Busy Or .readyState <> 4: DoEvents: Loop
  43.          Do: DoEvents
  44.             If InStr(.Document.body.innertext, "查無") Then  '查無 股票代號
  45.                 Rng.Offset(, 1) = "查無 " & Rng: Exit Sub
  46.                 ie.Quit
  47.             End If
  48.          Loop Until Not InStr(.Document.body.innertext, "查無")
  49.          If Rng.Row > 1 Then
  50.             Do: DoEvents
  51.                 Set E = .Document.querySelector("em[class='corp-name']")  '指定這元素  <em>  讀取   (股票名稱, 代號)
  52.                    '<em class="corp-name">台 泥<span class="stock-code">&nbsp;&nbsp;(1101)</span> </em>
  53.             Loop Until TypeName(E) = "HTMLPhraseElement"
  54.             If Trim(E.ALL.TAGS("SPAN")(0).innertext) <> "(" & Rng & ")" Then
  55.                 Rng.Offset(, 1) = "查無 " & Rng: Exit Sub
  56.             Else
  57.                 Rng.Cells(, 2) = Trim(Split(E.innertext, "(")(0))  'Split 函數  傳回一個陳列索引從零開始的一維陣列 , 它包含指定數目的子字串
  58.             End If
  59.             Set E = .Document.getelementbyid("stock_info_data_a").ALL.TAGS("SPAN")(0)    '股票價格    id="stock_info_data_a"
  60.              '<div class="price s-down fadein_black" id="stock_info_data_a">
  61.             '<span class="data_close s-down">18.95</span> **TAGS("SPAN")(0)   's-down 股價下降
  62.             '<span class="data_diff s-down">▼-0.10</span> **TAGS("SPAN")(1)
  63.             '<span class="data_diff s-down">-0.52%</span>  **TAGS("SPAN")(2)
  64.            '<span class="data_total">18.79<em>億</em></span></div>  **TAGS("SPAN")(3)
  65.             Rng.Cells(, 3) = E.innertext
  66.         End If
  67.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  68.         Do: DoEvents
  69.             Set E = .Document.ALL.TAGS("table")(1)
  70.         Loop Until TypeName(E) = "HTMLTable"
  71.          If Rng.Row > 1 Then Ar = Array(3, 5, 7, 9) Else Ar = Array(2, 4, 6, 8)
  72.                     'Rng.Row > 1 >>從第2列開始下載資料
  73.                      'Array(2, 4, 6, 8) 為標題的Row  **Ar = Array(3, 5, 7, 9 )為資料的Row
  74.         A = 4  '設定資料欄位的起始欄位,前有 1股票代碼欄,2股票名稱欄,3股票價格欄
  75.        For R = 0 To UBound(Ar) - 1
  76.            For C = 0 To E.Rows(Ar(R)).Cells.Length - 1
  77.             Rng.Cells(, A) = E.Rows(Ar(R)).Cells(C).innertext
  78.             A = A + 1  '資料欄位+1
  79.            Next
  80.        Next
  81.     End With
  82. Exit Sub
  83. Beerr:
  84. Set ie = New InternetExplorer
  85. GoTo Be
  86. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 14# GBKEE


    謝謝 版主  從 中學到很多。

TOP

回復 15# GBKEE


    謝謝 娰主 程式 , 學習中 。

googs.jpg (210.53 KB)

googs.jpg

TOP

回復 14# GBKEE
  1. Sub GetIncome() '取損益表(年表)網頁
  2. Dim Url, HTMLsourcecode, GetXml, TableG, i, j
  3. Set HTMLsourcecode = CreateObject("htmlfile")
  4. Set GetXml = CreateObject("msxml2.xmlhttp")
  5. Url = "http://kgieworld.moneydj.com/z/zc/zcq/zcqa/zcqa_2330.djhtm"
  6. With GetXml
  7. .Open "GET", Url, False
  8. .Send
  9. HTMLsourcecode.body.innerhtml = .Responsetext
  10. Set TableG = HTMLsourcecode.getelementsbyclassname("table-row")
  11. '***網頁的編碼**********************************
  12. '<div class="table-row">   為所要的資料 的網頁元素
  13. '<span class="t2 table-cell">期別</span>
  14. '<span class="t2 table-cell">2020</span>
  15. '<span class="t2 table-cell">2019</span>
  16. '<span class="t2 table-cell">2018</span>
  17. '<span class="t2 table-cell">2017</span>
  18. '<span class="t2 table-cell">2016</span>
  19. '<span class="t2 table-cell">2015</span>
  20. '<span class="t2 table-cell">2014</span>
  21. '<span class="t2 table-cell">2013</span>
  22. '</div>************************************
  23. For i = 0 To TableG.Length - 1
  24.     For j = 0 To TableG(i).all.tags("span").Length - 1
  25.        Cells(i + 1, j + 1) = TableG(i).all.tags("span")(j).innertext
  26.     Next j
  27. Next i
  28. End With
  29. Set HTMLsourcecode = Nothing '釋放記憶體
  30. Set GetXml = Nothing
  31. End Sub '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
複製代碼
請教 版大 我 office 2007 版 測試 程式
Set TableG = HTMLsourcecode.getelementsbyclassname("table-row")
這行會誤,是否版本的問題
謝謝 版大

Image 7.jpg (95.22 KB)

Image 7.jpg

TOP

回復 14# GBKEE


    這次網頁改版,抓取的有的股票行數不同,像金融股那一段取B67欄就不在那行,就嘗試用find ,全部上市可以跑完。

TOP

本帖最後由 GBKEE 於 2022-1-12 10:00 編輯

回復 18# wufonna
多寫幾行試試試試看
  1. Private Sub GetIncome() '取損益表(年表)網頁
  2.     Dim Url, HTMLsourcecode, GetXml, TableG As Object, i As Integer, j As Integer, a As Integer
  3.     Set HTMLsourcecode = CreateObject("htmlfile")
  4.     Set GetXml = CreateObject("msxml2.xmlhttp")
  5.     Url = "http://kgieworld.moneydj.com/z/zc/zcq/zcqa/zcqa_2330.djhtm"
  6.     With GetXml
  7.         .Open "GET", Url, False
  8.         .send
  9.         HTMLsourcecode.write .Responsetext
  10.         Do  '  程式運行速度快用迴圈,確保TableG物件下載完整
  11.             Set TableG = HTMLsourcecode.all.tags("div")
  12.             DoEvents
  13.             '**   "JScriptTypeInfo"  可在 區域變數視窗 查看
  14.             '** 或是   Debug.Print TypeName(TableG) 得知
  15.         Loop Until TypeName(TableG) = "JScriptTypeInfo"   
  16.           '*****得知 classname="table-row" 的位置
  17.         For a = 0 To TableG.Length - 1
  18.             'Debug.Print a, TableG(a).classname
  19.             If TableG(a).classname = "table-row" Then Exit For   '讀取資料起始列數
  20.         Next
  21.         '***************************************
  22.        With ActiveSheet
  23.             .Cells.Clear
  24.             For i = a To TableG.Length - 1
  25.                 For j = 0 To TableG(i).all.tags("span").Length - 1
  26.                     .Cells(i - (a - 1), j + 1) = TableG(i).all.tags("span")(j).innertext
  27.                     '****** i - ( a-1) >>修正從第一列開始下載資料
  28.                 Next j
  29.             Next i
  30.         End With
  31.         '***網頁的編碼**********************************
  32.         '<div class="table-row">   為所要的資料 的網頁元素
  33.         '<span class="t2 table-cell">期別</span>
  34.         '<span class="t2 table-cell">2020</span>
  35.         '<span class="t2 table-cell">2019</span>
  36.         '<span class="t2 table-cell">2018</span>
  37.         '<span class="t2 table-cell">2017</span>
  38.         '<span class="t2 table-cell">2016</span>
  39.         '<span class="t2 table-cell">2015</span>
  40.         '<span class="t2 table-cell">2014</span>
  41.         '<span class="t2 table-cell">2013</span>
  42.         '</div>************************************
  43.     End With
  44.     Set HTMLsourcecode = Nothing '釋放記憶體
  45.     Set GetXml = Nothing
  46. End Sub '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 一個人不怕錯,就怕不改過,改過並不難。
返回列表 上一主題