从网页抓取铜价

jsb03

如题，点击按钮可以从https://www.ccmn.cn/抓取当天1#铜的均价，把图片中的四个数据保存在sheet1中的A1-D1单元格内。

jsb03

可能需要用户名和密码

2801959927

那个首页数据是动态页面，不太好爬取的。建议你点进去看这个页面：https://www.ccmn.cn/cjxh.shtml



这个页面稍微清爽一点，其实都不用写爬虫代码，直接用Excel从web获取数据，就可以把这张表格导入到excel里，还可以自己刷新，试试吧

perfect131

不难，仅供参考
第一种 ；split 第二种 正则

1. Sub ccmn()
   
2.     Set winhttp = CreateObject("winhttp.WinHttpRequest.5.1")
   
3.     Url = "https://www.ccmn.cn/index_table/"
   
4.     With winhttp
   
5.         .Open "GET", Url, False
   
6.         .send
   
7.         strText = .responseText
   
8.         If InStr(strText, "<td>1#铜</td>") Then
   
9.             aa = Split(Split(strText, "<td>1#铜</td>")(1), "</tr>")(0)
   
10.             bb = Split(Replace(Replace(aa, " ", ""), vbLf, ""), "<td>")
    
11.             ReDim arr(1 To 1, 1 To 4)
    
12.             arr(1, 1) = "1#铜" ''品名
    
13.             arr(1, 2) = Val(Split(bb(2), "<")(0)) ''均价
    
14.             arr(1, 3) = Val(Split(Split(bb(2), """>")(1), "<")(0)) ''涨跌
    
15.             arr(1, 4) = Split(bb(4), "<")(0) ''日期
    
16.             '' a1开始写入
    
17.             Sheet1.[a1].Resize(1, 4) = arr
    
18.         End If
    
19.     End With
    
20.     Set winhttp = Nothing
    
21. End Sub
    
22. Sub ccmn1()
    
23.     Set winhttp = CreateObject("winhttp.WinHttpRequest.5.1")
    
24.     Url = "https://www.ccmn.cn/index_table/"
    
25.     Set reg = CreateObject("vbscript.regexp")
    
26.     reg.Pattern = "(-)|(</)|\n|\s|\D"
    
27.     reg.Global = True
    
28.     With winhttp
    
29.         .Open "GET", Url, False
    
30.         .send
    
31.         strText = .responseText
    
32.         If InStr(strText, "<td>1#铜</td>") Then
    
33.             aa = Split(Split(strText, "<td>1#铜</td>")(1), "</tr>")(0)
    
34.             mm = reg.Replace(aa, "$1$2")
    
35.             bb = Split(mm, "</")
    
36.             ReDim arr(1 To 1, 1 To 4)
    
37.             arr(1, 1) = "1#铜" ''品名
    
38.             arr(1, 2) = Val(bb(1)) ''均价
    
39.             arr(1, 3) = Val(bb(2)) ''涨跌
    
40.             arr(1, 4) = bb(4)      ''日期
    
41.             '' a2开始写入
    
42.             Sheet1.[a2].Resize(1, 4) = arr
    
43.         End If
    
44.     End With
    
45.     Set reg = Nothing
    
46.     Set winhttp = Nothing
    
47. End Sub

复制代码

jsb03

感谢楼上的大神