麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 無法匯入PCHOME 股市資料 [打印本頁]

作者: chairmen100 時間: 2013-9-26 21:33 標題: 無法匯入PCHOME 股市資料

我想要匯入PCHOME 股市資料如下卻都是空白或是從"資料"->從WEB 卻得到此WEB查詢沒有資料傳回的錯誤訊息有高手可以解惑嗎

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://pchome.syspower.com.tw/stock/sto2/ock2/sid2330.html", Destination:=Range( _
"A1"))

作者: GBKEE 時間: 2013-9-27 17:08

回復 1# chairmen100
試試看

Option Explicit
Sub Pchome_財務比率()
Dim A As Object, i As Integer, C As Variant
With CreateObject("InternetExplorer.application")
.Navigate "http://pchome.syspower.com.tw/stock/sto2/ock2/sid2330.html"
.Visible = True
Do While .Busy Or .ReadyState <> 4
DoEvents
Loop
Set A = .Document.getelementsbytagname("table")(4)
With ActiveSheet
.Cells.Clear
For i = 1 To A.Rows.Length - 1
For C = 0 To A.Rows(i).Cells.Length - 1
.Cells(i, C + 1) = A.Rows(i).Cells(C).innertext
Next
Next
With .UsedRange
.Columns(.Columns.Count).SpecialCells(xlCellTypeConstants).Offset(, -9).Delete xlShiftToLeft
End With
End With
.Quit
End With
MsgBox "OK"
End Sub

複製代碼

作者: chairmen100 時間: 2013-9-27 19:56

回復 2# GBKEE

感謝G大結果符合期望

作者: ML089 時間: 2013-9-28 18:28

GBKEE超版對查詢股票程式很厲害，如果能整理成專輯應該可以造福很多人。

作者: pctung9201 時間: 2013-10-2 18:51

回復 chairmen100
試試看
GBKEE 發表於 2013-9-27 17:08

真是造福大家~感謝

作者: tajen 時間: 2013-10-19 23:10

請教GBKEE大大:
以下的網頁有圖，又該如何處理？(其實只要數字資料就可以了)，麻煩您有空看一下，謝謝。
http://pchome.syspower.com.tw/stock/sto0/ock2/sid1319.html

作者: GBKEE 時間: 2013-10-20 16:51

回復 6# tajen
試試看

Option Explicit
Sub Pchome_價量分布()
Dim A As Object, i As Integer, C As Variant, Sh As Worksheet, Stock As String
Do
Stock = InputBox("輸入股票代號", "股票代號", 2303)
Loop Until Len(Stock) >= 4
Set Sh = ActiveSheet '可指定工作表
With CreateObject("InternetExplorer.application")
.Navigate "http://pchome.syspower.com.tw/stock/sto0/ock2/sid" & Stock & ".html"
.Visible = True
Do While .Busy Or .ReadyState <> 4
DoEvents
Loop
Sh.Cells.Clear
Set A = .Document.getelementsbytagname("table")(0)
For i = 0 To A.Rows.Length - 1
For C = 0 To A.Rows(i).Cells.Length - 1
ActiveSheet.Cells(i + 1, C + 1) = A.Rows(i).Cells(C).innertext
Next
Next
Set A = .Document.getelementbyid("content")
For i = 0 To A.Rows.Length - 1
For C = 0 To A.Rows(i).Cells.Length - 1
ActiveSheet.Cells(i + 4, C + 1) = A.Rows(i).Cells(C).innertext
Next
Next
Sh.UsedRange.EntireColumn.AutoFit
.Quit
End With
MsgBox "OK"
End Sub

複製代碼

作者: genes 時間: 2013-10-21 01:42

回復 7# GBKEE

很強大,GBKEE大大. 套用在工作上, 非常有效率. 要好好參詳

作者: tajen 時間: 2013-10-25 01:07

不好意思，現在才來看回覆，沒想到GBKEE大大早就寫好了，測試的結果:完美無缺。
太感謝GBKEE大大，感恩!
您實在太厲害了，我要好好來研究一下你的這二篇code，希望以後都可自己把程式寫出來。

想請教另外一個問題: 如何定位網頁中有Tab的位置
例如: http://www.cnyes.com/twstock/quote/6121.htm 中的第三個Tab(價量圖)的資料

因為若直接用excel匯入的方式，都只會抓到第一個Tab(最佳五檔)的資料，
可否麻煩您有空看一下，謝謝!!!

作者: joey0415 時間: 2013-10-25 18:12

下面是網頁的表格，改成7就行了

Sub Macro2()
'
With ActiveSheet.QueryTables.Add(Connection:= _
      "URL;http://traderoom.cnyes.com/tse/quote2FB.aspx?code=6121", Destination:= _
      Range("A1"))
      .Name = "quote2FB.aspx?code=6121"
      .FieldNames = True
      .RowNumbers = False
      .FillAdjacentFormulas = False
      .PreserveFormatting = True
      .RefreshOnFileOpen = False
      .BackgroundQuery = True
      .RefreshStyle = xlInsertDeleteCells
      .SavePassword = False
      .SaveData = True
      .AdjustColumnWidth = True
      .RefreshPeriod = 0
      .WebSelectionType = xlSpecifiedTables
      .WebFormatting = xlWebFormattingNone
      .WebTables = "7"
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=False
End With
End Sub

作者: c_c_lai 時間: 2013-10-26 08:33

回復 9# tajen
提供參考： (不知是否吻合你的需求？)

Sub 最佳五檔()
Dim Sh As Worksheet
Set Sh = Sheets("工作表3") ' 可指定工作表
With Sh
.Cells.Clear
.Select
With .QueryTables.Add(Connection:= _
"URL;http://traderoom.cnyes.com/tse/quote2FB.aspx?code=6121", Destination:= _
.Range("F1"))
.WebFormatting = xlWebFormattingNone
.WebTables = "7"
.Refresh BackgroundQuery:=False
End With
With .QueryTables.Add(Connection:= _
"URL;http://traderoom.cnyes.com/tse/quote2FB.aspx?code=6121", Destination:= _
.Range("A1"))
.WebFormatting = xlWebFormattingNone
.WebTables = "8,10,11" ' 網頁的表格，更改 WebTables 就行了
' .WebTables = "7,8,10,11"
' .WebTables = "6,8,10,11"
.Refresh BackgroundQuery:=False
End With
With .QueryTables.Add(Connection:= _
"URL;http://traderoom.cnyes.com/tse/quote2FB.aspx?code=6121", Destination:= _
.Range("I1"))
.WebFormatting = xlWebFormattingNone
.WebTables = "6"
.Refresh BackgroundQuery:=False
End With
.Range("A:N").EntireColumn.AutoFit
End With
End Sub

複製代碼

作者: GBKEE 時間: 2013-10-26 16:47

回復 9# tajen
將以下文字複製於[小作家]或[記事本] 存檔為 "價量圖.iqy" (.iqy 查詢檔的副檔名)後,請雙擊 "價量圖.iqy".
ps:那一行空白是必須的

WEB
1
http://traderoom.cnyes.com/tse/quote2FB.aspx?code=["價量圖","請輸入股票代號:如 2317"]
Selection=7
Formatting=None
PreFormattedTextToColumns=True
ConsecutiveDelimitersAsOne=True
SingleBlockTextImport=False
DisableDateRecognition=False
DisableRedirections=False

複製代碼

作者: genes 時間: 2013-10-27 15:19

回復 12# GBKEE

Microsoft Office Excel could not open or read this query file. Either the file has been damaged or the file format is not valid :(

作者: GBKEE 時間: 2013-10-27 15:28

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

[attach]16483[/attach]

作者: genes 時間: 2013-10-27 20:34

回復 14# GBKEE

原來是英文版office和中文版的不兼容, 改成英文可以. 有沒有辦法能兼容?

另外iqy在那裡可以學到? 沒有聽過

作者: tajen 時間: 2013-10-27 21:02

To:joey0415 大大
謝謝您告知webtables=7，我沒想到可以這樣推算，感恩。

To: GBKEE大大
真的是太完美了，又多學了一些，真的很感謝。甘恩啦!!!

作者: GBKEE 時間: 2013-10-28 15:59

回復 15# genes
搜尋 iqy

作者: chairmen100 時間: 2013-11-9 22:08

請教 G大大 , 如果輸入錯誤股票代碼網頁顯示查無資料導致停在 DoEvents 無限迴圈如何加入錯誤檢查"查無資料" 謝謝

.Navigate "http://pchome.syspower.com.tw/stock/sto0/ock2/sid" & Stock & ".html"
      .Visible = True
      Do While .Busy Or .ReadyState <> 4
         DoEvents
      Loop

作者: GBKEE 時間: 2013-11-10 09:48

回復 18# chairmen100

With CreateObject("InternetExplorer.application")
.Navigate "http://pchome.syspower.com.tw/stock/sto0/ock2/sid" & Stock & ".html"
.Visible = True
T = Time
Do While .Busy Or .ReadyState <> 4
DoEvents
If Time - T > #12:00:05 AM# Then End '超過5秒停止程序
Loop

複製代碼

作者: hsiao13 時間: 2013-12-26 08:41

GBKEE 大大
請問為何我使用你的程式碼還是無法匯入http://pchome.syspower.com.tw/stock/sto2/ock2/sid2330.html
這網頁的資料，是哪錯了?
難道需要特別的設定或步驟???
可否指導一下。

作者: hsiao13 時間: 2013-12-26 09:08

GBKEE 大大
歹勢，我的問題打錯了。
我是要問我使用你的程式碼如何讓http://pchome.syspower.com.tw/stock/sto2/ock2/sid2330.html
可以選擇不同的股票代碼匯入這網頁的資料
可否指導一下。

作者: cji3cj6xu6 時間: 2013-12-26 11:59

若將代號放在a1的位置，應該是這樣寫吧！
WebAddress = "/pchome.syspower.com.tw/stock/sto2/ock2/sid" & [A1] & ".htm"

作者: GBKEE 時間: 2013-12-26 16:24

回復 20# hsiao13

程式碼還是無法匯入http://pchome.syspower.com.tw/stock/sto2/ock2/sid2330.html

對不起了,這網頁我搞不定它.

作者: hsiao13 時間: 2013-12-26 17:25

回復 2# GBKEE
我想問如何能在excel中可以直接輸入代碼，在大大的程式碼中只有2330能輸出！

作者: GBKEE 時間: 2013-12-27 14:10

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

要在excel中直接輸入代碼, cji3cj6xu6 22# 可參考,但這網頁無法匯入資料.

作者: stillfish00 時間: 2013-12-27 20:28

回復 25# GBKEE
回復 24# hsiao13
24# 應該是指2#的方法吧？
比照7# InputBox 修改就好了。。。

作者: iorikoyzz 時間: 2015-11-23 15:43

請問各位大大,為什麼我這樣寫沒有辦法抓取 pchome 股票排行
如以下網址: http://pchome.megatime.com.tw/rank/sto0/ock08.html
都會抓到空白,
Sub 抓每月營收(weburl As String)
Sheets("Temp").Activate

With ActiveSheet.QueryTables.Add(Connection:= _
      "URL;" & weburl, Destination:=Range("A1"))
      .FieldNames = True
      .RowNumbers = False
      .FillAdjacentFormulas = False
      .PreserveFormatting = True
      .RefreshOnFileOpen = False
      .BackgroundQuery = True
      .RefreshStyle = xlInsertDeleteCells
      .SavePassword = False
      .SaveData = True
      .AdjustColumnWidth = True
      .RefreshPeriod = 0
      .WebSelectionType = xlSpecifiedTables
      .WebFormatting = xlWebFormattingNone
      .WebTables = "7"
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=False

End With
End Sub

作者: GBKEE 時間: 2015-11-24 09:10

回復 27# iorikoyzz

這網頁用QueryTables無效
試試看

Option Explicit
Sub 抓每月營收(weburl As String)
Dim i As Integer, E As Object, K, R
Sheets("Temp").Activate
ActiveSheet.Cells.Clear
With CreateObject("InternetExplorer.Application")
.Visible = True '顯示網頁
.Navigate weburl
Do While .Busy Or .readyState <> 4: DoEvents: Loop
Set E = .Document.all.TAGS("TABLE")(0)
K = 1
For Each R In E.Rows
For i = 0 To R.Cells.Length - 1
ActiveSheet.Cells(K, i + 1) = R.Cells(i).INNERTEXT
Next
K = K + 1
Next
.Quit '關閉網頁
End With
End Sub

複製代碼

作者: iorikoyzz 時間: 2015-11-27 09:50

Hi GBKEE大大:

你太強了,這可以用

非常謝謝你!!,
不過這是為什麼呢??

thanks

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)