网页提取

YZC51

学不完用不尽 发表于 2015-10-27 00:19
这四行代码，取不出数据！
貌似需要设置等待时间。

这样试下

1. Sub test1()
   
2.     Set myQuery = ActiveSheet.QueryTables.Add(Connection:="URL;http://chart.cp.360.cn/kaijiang/qxc?lotId=110022&spanType=0&span=1000&r=0.9777160357816834#roll_0/", Destination:=[a1])
   
3.     myQuery.Refresh
   
4. End Sub

复制代码

学不完用不尽

YZC51 发表于 2015-10-27 00:33
这样试下

这样无法进行后期操作，C列数据被隐藏了（字体颜色是白色）。建议再增加点东东，以便于其他操作。

学不完用不尽

YZC51 发表于 2015-10-25 11:15
或

微微改动了一下，可以取到数据。

1. Sub test1() '取1000期
   
2.     Dim myQuery
   
3.     [A:Z].Clear
   
4.     Set myQuery = ActiveSheet.QueryTables.Add(Connection:="URL;http://chart.cp.360.cn/kaijiang/qxc?lotId=110022&spanType=0&span=1000&r=0.9777160357816834#roll_0/", Destination:=[a1])
   
5.     myQuery.Refresh False
   
6. 'expression.Refresh(BackgroundQuery)
   
7. 'expression   必需。该表达式返回一个 QueryTable 对象。
   
8. 'BackgroundQuery    Variant 类型，可选。
   
9. '只用于基于 SQL 查询结果的 QueryTable。
   
10. '如果该值为 True，则在数据库建立连接并提交查询之后，将控制返回到过程。
    
11. 'QueryTable 在后台进行更新。如果该值为 False，则在所有数据被取回到工作表之后，将控制返回到过程。
    
12. '如果没有指定该参数的值，则 BackgroundQuery 属性的设置将决定查询模式。
    
13. 
    
14.     [1:3].Delete
    
15.     [C:C].Font.ColorIndex = 56
    
16. End Sub

复制代码

学不完用不尽

帮助文件注释：

Refresh 方法
应用于 QueryTable 对象的 Refresh 方法。
更新外部数据区域 (QueryTable)。Boolean 类型。
expression.Refresh(BackgroundQuery)
expression      必需。该表达式返回一个 QueryTable 对象。
BackgroundQuery      Variant 类型，可选。只用于基于 SQL 查询结果的 QueryTable。如果该值为 True，则在数据库建立连接并提交查询之后，将控制返回到过程。QueryTable 在后台进行更新。如果该值为 False，则在所有数据被取回到工作表之后，将控制返回到过程。如果没有指定该参数的值，则 BackgroundQuery 属性的设置将决定查询模式。
说明
下列说明应用于基于 SQL 查询结果的 QueryTable 对象。
Refresh 方法使 Microsoft Excel 连接到 QueryTable 对象的数据源，执行 SQL 查询，并将数据返回至基于 QueryTable 对象的区域。仅当调用该方法之后，QueryTable 对象才会与数据源进行通信。
当建立对 OLE DB 或 ODBC 数据源的连接时，Microsoft Excel 使用由 Connection 属性指定的连接字符串。如果指定的连接字符串缺少必需的值，则将显示一个对话框，提示用户输入必需的信息。如果 DisplayAlerts 属性值为False，则不显示对话框，而且 Refresh 方法将由于“连接信息不足”异常而失效。
在 Microsoft Excel 建立一个成功的连接之后，将保存完整的连接字符串，这样，在同一编辑会话中以后调用 Refresh 方法时就不会显示提示。通过检验 Connection 属性的值，可以取得完整的连接字符串。
完成数据库连接后，将检查 SQL 查询的有效性。如果该查询无效，Refresh 方法将失效并导致“SQL 语法错误”异常。
如果查询需要参数，在调用 Refresh 方法之前，必须用参数绑定信息初始化 Parameters 集合。若未绑定足够参数，Refresh 方法失效并导致“参数错误”异常。如果把参数设置为提示用户指定，则无论 DisplayAlerts 如何设置，都将对话框显示给用户。如果用户取消一个参数对话框，则 Refresh 方法停止，并且该值为 False。如果向 Parameters 集合绑定了多余的参数，则这些多余的参数将被忽略。
如果成功地完成或启动查询，则 Refresh 方法的值为 True；如果用户取消连接或参数对话框，该方法返回 False。
检测 FetchedRowOverflow 属性以判断取得的数据行数是否超出了工作表的可用行数。每次调用 Refresh 方法之前，该属性都将初始化。

YZC51

请测试

1. Sub test1() '取1000期
   
2.     Dim myQuery
   
3.     With Sheets("Sheet1")
   
4.     .[A:J].Clear
   
5.         Set myQuery = .QueryTables.Add(Connection:="URL;http://chart.cp.360.cn/kaijiang/qxc?lotId=110022&spanType=0&span=1000&r=0.9777160357816834#roll_0/", Destination:=.[a1])
   
6.         myQuery.Refresh False
   
7. 'expression.Refresh(BackgroundQuery)
   
8. 'expression   必需。该表达式返回一个 QueryTable 对象。
   
9. 'BackgroundQuery    Variant 类型，可选。
   
10. '只用于基于 SQL 查询结果的 QueryTable。
    
11. '如果该值为 True，则在数据库建立连接并提交查询之后，将控制返回到过程。
    
12. 'QueryTable 在后台进行更新。如果该值为 False，则在所有数据被取回到工作表之后，将控制返回到过程。
    
13. '如果没有指定该参数的值，则 BackgroundQuery 属性的设置将决定查询模式。
    
14. 
    
15.         .[1:3].Delete
    
16.         .[C:C].Font.ColorIndex = 56
    
17.     End With
    
18. End Sub
    
19. 
    
20. Sub Click()
    
21. Call test1
    
22.     Sheets("Sheet1").Range("A1:J3").Copy
    
23.     [a1:j3].PasteSpecial Paste = 0 '无条件粘贴
    
24. End Sub

复制代码

YZC51

附件上传
QT加强版.rar (64.24 KB, 下载次数: 32)

2015-10-28 08:31 上传

点击文件名下载附件

学不完用不尽

YZC51 发表于 2015-10-28 08:31
附件上传

很好，赞一个！

学不完用不尽

YZC51 发表于 2015-10-28 08:28
请测试

字体颜色使用自定义的颜色，赞一个！

YZC51

谢谢夸奖！在帖子中跟您学的不少知识！

YZC51

本代码参考吴老师例程和学不完用不尽老师的指导作了修改,在此致谢！

1. Sub test1() '取1000期 本代码参考吴老师例程和学不完用不尽老师的指导作了修改,在此致谢！
   
2.    [A:J].Clear
   
3.     URL = "http://chart.cp.360.cn/kaijiang/qxc?lotId=110022&spanType=0&span=1000&r=0.9777160357816834#roll_0/"
   
4.     With ActiveSheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=[a2])
   
5.         .WebFormatting = 1 'xlWebFormattingNone '指定是否包含格式
   
6.         .WebSelectionType = 0 'xlSpecifiedTables '指定table模式
   
7.         .WebTables = "2" '第2张table
   
8.         .Refresh False
   
9.        ' .[1:3].Delete
   
10.         [C:C].Font.ColorIndex = 56
    
11.     End With
    
12. End Sub

复制代码