请问怎么提取网页中的价格http://www.go24k.com/

petersuper

如题，请问怎么提取网页中的价格，excel宏可以做吗
网址：http://www.go24k.com/
品种 最新价 涨跌
Ag(T+D) 7434 -167.00
Au(T+D) 314.2 -3.21
Au100g 315 -3.01
Au99.95 314.2 -3.46
Au99.99 314.5 -3.38
Pt99.95 362.5 -6.85
Au(T+N1) 0 0
Au(T+N2) 0 0

petersuper

没人知道吗？

xmyjk

搞不定，所需数据再IFRAME里面，我尝试过，被拒绝访问，不知其他高手有无什么招能解决的。

ah2005

楼主去用火车头采集器试试.

xmyjk

草草做了一个，如下：

1. Option Explicit
   
2. Sub a()
   
3. Dim ie1 As Object, t As Single, url As String
   
4. 
   
5. UserForm1.WebBrowser1.Silent = True
   
6. 
   
7. [a1].CurrentRegion.Clear
   
8. Cells.NumberFormat = "@"
   
9. Set ie1 = UserForm1.WebBrowser1
   
10. 
    
11. With ie1
    
12.   .Navigate "http://www.go24k.com/" '网址
    
13.   t = Timer
    
14.   Do Until Timer > t + 2
    
15.      DoEvents
    
16.   Loop
    
17.   
    
18.   url = "http://quote.go24k.com:8080/showshxhhq.asp"
    
19.   .Document.body.innerHTML = "<a  href='" & url & "'>ffffff</a>"
    
20.   .Document.all.tags("a")(0).Click
    
21.   t = Timer
    
22.   Do Until Timer > t + 1
    
23.        DoEvents
    
24.   Loop
    
25.   .Document.body.Focus
    
26.   .Document.execCommand "SelectAll"
    
27.   .Document.execCommand "copy"
    
28. End With
    
29. 
    
30. Range("A1").Select
    
31. ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
    
32. Rows(1).Delete Shift:=xlUp
    
33. 
    
34. Set ie1 = Nothing
    
35. 
    
36. End Sub
    

复制代码

xmyjk

感谢apollokk老师指导，又修改了下代码，代码如下：

1. Option Explicit
   
2. Sub a()
   
3. Dim ie1 As Object, t As Single, url As String
   
4. 
   
5. UserForm1.WebBrowser1.Silent = True
   
6. On Error Resume Next
   
7. 'Load UserForm1
   
8. 'UserForm1.Show 0
   
9. [a1].CurrentRegion.Clear
   
10. Cells.NumberFormat = "@"
    
11. Set ie1 = UserForm1.WebBrowser1
    
12. 
    
13. With ie1
    
14.   .Navigate "http://www.go24k.com/" '网址
    
15.   t = Timer
    
16.   Do Until InStr(.Document.body.innertext, "上金所") > 0
    
17.      DoEvents
    
18.   Loop
    
19.   
    
20.   url = "http://quote.go24k.com:8080/showshxhhq.asp"
    
21.   .Document.body.innerHTML = "<a  href='" & url & "'>ffffff</a>"
    
22.   .Document.all.tags("a")(0).Click
    
23.   t = Timer
    
24.   Do Until InStr(.Document.body.innertext, "Ag(T+D)") > 0
    
25.        DoEvents
    
26.   Loop
    
27.   .Document.body.Focus
    
28.   .Document.execCommand "SelectAll"
    
29.   .Document.execCommand "copy"
    
30. End With
    
31. 
    
32. Range("A1").Select
    
33. ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
    
34. Rows(1).Delete Shift:=xlUp
    
35. 
    
36. Set ie1 = Nothing
    
37. 
    
38. End Sub
    

复制代码

petersuper

谢谢各位大大，很好用，但是问一下，这个可以让数据自动刷新吗？比如每5s刷一次数据

petersuper

谢谢各位大大，很好用，但是问一下，这个可以让数据自动刷新吗？比如每5s刷一次数据

petersuper

请问怎么引用这个数据的，大大

xmyjk

原帖由 petersuper 于 2011-7-7 09:14 发表
请问怎么引用这个数据的，大大

试看看这个。