返回列表 上一主題 發帖

[發問] 無法匯入PCHOME 股市資料

回復 1# chairmen100
試試看
  1. Option Explicit
  2. Sub Pchome_財務比率()
  3.     Dim A As Object, i As Integer, C As Variant
  4.     With CreateObject("InternetExplorer.application")
  5.         .Navigate "http://pchome.syspower.com.tw/stock/sto2/ock2/sid2330.html"
  6.         .Visible = True
  7.         Do While .Busy Or .ReadyState <> 4
  8.              DoEvents
  9.         Loop
  10.         Set A = .Document.getelementsbytagname("table")(4)
  11.         With ActiveSheet
  12.             .Cells.Clear
  13.             For i = 1 To A.Rows.Length - 1
  14.                 For C = 0 To A.Rows(i).Cells.Length - 1
  15.                    .Cells(i, C + 1) = A.Rows(i).Cells(C).innertext
  16.                 Next
  17.             Next
  18.             With .UsedRange
  19.                 .Columns(.Columns.Count).SpecialCells(xlCellTypeConstants).Offset(, -9).Delete xlShiftToLeft
  20.             End With
  21.        End With
  22.        .Quit
  23.     End With
  24.     MsgBox "OK"
  25. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 6# tajen
試試看
  1. Option Explicit
  2. Sub Pchome_價量分布()
  3.     Dim A As Object, i As Integer, C As Variant, Sh As Worksheet, Stock As String
  4.     Do
  5.         Stock = InputBox("輸入股票代號", "股票代號", 2303)
  6.     Loop Until Len(Stock) >= 4
  7.     Set Sh = ActiveSheet                   '可指定工作表
  8.     With CreateObject("InternetExplorer.application")
  9.         .Navigate "http://pchome.syspower.com.tw/stock/sto0/ock2/sid" & Stock & ".html"
  10.         .Visible = True
  11.         Do While .Busy Or .ReadyState <> 4
  12.              DoEvents
  13.         Loop
  14.         Sh.Cells.Clear
  15.         Set A = .Document.getelementsbytagname("table")(0)
  16.         For i = 0 To A.Rows.Length - 1
  17.             For C = 0 To A.Rows(i).Cells.Length - 1
  18.                 ActiveSheet.Cells(i + 1, C + 1) = A.Rows(i).Cells(C).innertext
  19.             Next
  20.         Next
  21.         Set A = .Document.getelementbyid("content")
  22.         For i = 0 To A.Rows.Length - 1
  23.             For C = 0 To A.Rows(i).Cells.Length - 1
  24.                 ActiveSheet.Cells(i + 4, C + 1) = A.Rows(i).Cells(C).innertext
  25.             Next
  26.         Next
  27.         Sh.UsedRange.EntireColumn.AutoFit
  28.        .Quit
  29.     End With
  30.     MsgBox "OK"
  31. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 9# tajen
將以下文字複製於[小作家]或[記事本] 存檔為 "價量圖.iqy" (.iqy 查詢檔的副檔名)後,請雙擊 "價量圖.iqy".
ps:那一行空白是必須的
  1. WEB
  2. 1
  3. http://traderoom.cnyes.com/tse/quote2FB.aspx?code=["價量圖","請輸入股票代號:如 2317"]

  4. Selection=7
  5. Formatting=None
  6. PreFormattedTextToColumns=True
  7. ConsecutiveDelimitersAsOne=True
  8. SingleBlockTextImport=False
  9. DisableDateRecognition=False
  10. DisableRedirections=False
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 13# genes
一樣是 2003版 ,為何你的不行

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 15# genes
搜尋 iqy
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 18# chairmen100
  1.   With CreateObject("InternetExplorer.application")
  2.         .Navigate "http://pchome.syspower.com.tw/stock/sto0/ock2/sid" & Stock & ".html"
  3.         .Visible = True
  4.         T = Time
  5.         Do While .Busy Or .ReadyState <> 4
  6.              DoEvents
  7.              If Time - T > #12:00:05 AM# Then End  '超過5秒 停止程序
  8.         Loop
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 20# hsiao13

對不起了,這網頁我搞不定它.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復  GBKEE
我想問如何能在excel中可以直接輸入代碼,在大大的程式碼中只有2330能輸出!
hsiao13 發表於 2013/12/26 17:25


要在excel中直接輸入代碼, cji3cj6xu6 22# 可參考,但這網頁無法匯入資料.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 27# iorikoyzz

這網頁 用QueryTables無效
試試看
  1. Option Explicit
  2. Sub 抓每月營收(weburl As String)
  3.     Dim i As Integer, E As Object, K, R
  4.     Sheets("Temp").Activate
  5.     ActiveSheet.Cells.Clear
  6.     With CreateObject("InternetExplorer.Application")
  7.         .Visible = True '顯示網頁
  8.         .Navigate weburl
  9.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  10.         Set E = .Document.all.TAGS("TABLE")(0)
  11.         K = 1
  12.         For Each R In E.Rows
  13.             For i = 0 To R.Cells.Length - 1
  14.                 ActiveSheet.Cells(K, i + 1) = R.Cells(i).INNERTEXT
  15.             Next
  16.             K = K + 1
  17.         Next
  18.         .Quit        '關閉網頁
  19.     End With
  20. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 成功是優點的發揮,失敗是缺點的累積。
返回列表 上一主題