海淘族求宏程序自动抓取雅虎信息

bluexuemei

1. Sub getwebdata1()
   
2. '需要安装ACTIVERUBY ，下载地址 http://www.artonx.org/data/asr/Ruby-2.1.1.msi
   
3.     Dim url, y
   
4.     Set oJs = CreateObject("scriptcontrol"): oJs.Language = "rubyscript"
   
5.     For r = 2 To [c2].End(4).Row
   
6.          url = Cells(r, 3).Value
   
7.          y = oJs.eval("require 'open-uri';r=Regexp.new('decTxtAucPrice,StartPrice,EndTime,SellerID'.gsub(/,/,'|'));s=open(%Q(" & url & "),&:read).to_s.scan(/#{r}"">([\s\S]*?)</).flatten.insert(2,'').map{|x|x.encode('gbk')}")
   
8.          Cells(r, 4).Resize(1, 5) = y
   
9.     Next
   
10.     Set oJs = Nothing
    
11.     'Stop
    
12. End Sub

复制代码

怪盗KID

bluexuemei 发表于 2014-12-31 00:50

谢谢朋友你这么速度这么给力，程序我已试用过了，非常赞。以后我就指望它了。
还有几个小问题希望您能帮忙继续跟进：
1，目前A列的宝贝名称程序还无法提取出来；
2，目前程序应该是对C列所有的网址做读取，但是因为日雅网址一段时间后连接会失效，所以会造成对已经读取好的行破坏（变为空）。希望程序能针对我选中的C列单元格相关内容进行读取，如我选中C4、C6两个单元格，程序自动只针对这两个网址进行读取，我原来编过别的程序是用
Dim Cell As Range
    For Each Cell In Selection

Next Cell
的方法，本想自己改写，奈何差距太大，搞不定。
3，读取过来的单元格似乎是自动换行，能否在读取的时候只读字节，不读格式。

以上还是麻烦您了，能否麻烦您私信我一下您的手机号码？一方面想充值30元聊表谢意，另一方面对您怎么找到的这个MSI，以及怎么知道网址的哪段信息怎么读出来很感兴趣，想讨教一二。谢谢。

bluexuemei

读取的单元格应该不会自动换行吧。你为什么要选择C4和C6，都提取出来不好吗？

怪盗KID

bluexuemei 发表于 2014-12-31 12:48
读取的单元格应该不会自动换行吧。你为什么要选择C4和C6，都提取出来不好吗？

因为这个表格是长期行为，时间跨度应该会超过一年，比如年初1月份我买了东西，运行宏后提取好了，但是到了同年7月份日雅上就没有信息了，但是我8月份买的网址会继续贴上，一运行宏，8月份的出来了，1月份的却没有了，呵呵，大概就是这个情况了。

怪盗KID

bluexuemei 发表于 2014-12-31 12:48
读取的单元格应该不会自动换行吧。你为什么要选择C4和C6，都提取出来不好吗？

例如    10月 24日(金)（换行）
22時 21分
我看了下，即使把单元格设置为不自动换行也没有，应该是网页上的信息有自动换行符号吧（不可见字符？）。

bluexuemei

明白你的意思了，我处理一下

bluexuemei

1. Sub getwebdata()
   
2. '需要安装ACTIVERUBY ，下载地址 http://www.artonx.org/data/asr/Ruby-2.1.1.msi
   
3.     Dim url, y
   
4.     Set oJs = CreateObject("scriptcontrol"): oJs.Language = "rubyscript"
   
5.      For Each Cell In Selection
   
6.          url = Cell.Value
   
7.          y = oJs.eval("require 'open-uri';r=Regexp.new('decTxtAucPrice,StartPrice,EndTime,SellerID'.gsub(/,/,'|'));s=open(%Q(" & url & "),&:read).to_s.scan(/#{r}"">([\s\S]*?)</).flatten.insert(2,'').map{|x|x.encode('gbk').gsub(10.chr,'')}")
   
8.          y1 = oJs.eval("require 'open-uri';s=open(%Q(" & url & "),&:read).to_s.scan(/title>(.+?)(?=\-)/)[0][0].encode('gbk')")
   
9.          Cell(1, 2).Resize(1, 5) = y
   
10.          Cell(1, -1) = y1
    
11.     Next
    
12.     Set oJs = Nothing
    
13.     Columns("a:h").AutoFit
    
14.     'Stop
    
15. End Sub

复制代码

怪盗KID

bluexuemei 发表于 2014-12-31 13:40

无敌了你简直，这次完美的实现了我的所有要求。朋友，授我以渔吧，或者告诉我该学什么资料吧。

另外我还有一项需求，之前我觉得EXCEL宏不可能解决，现在想法动摇了。

您看到日雅每个链接下面都有1-3张图片了吗？就是宝贝照片。能不能编个宏，将他们都存在我指定的文件夹里面，每个照片可以简单的命名1、2、3.jpg，存放照片的直接文件夹名称，可以用宝贝的名称命名（也就是刚才您编写的程序的运行结果）。

当然还是我指定的网址，而不要全部网址，最好还是FOR EACH。

朋友你要是不愿意给我手机号码，请给我一下支付宝账户名吧，要不我真的没脸问了。

怪盗KID

bluexuemei 发表于 2014-12-31 13:40

顺便一说，日雅上的照片我都没办法点击右键进行复制或者保存，你看看你能对付吗？

bluexuemei

这个也不难，就是几行代码的问题