[已解决]还是XML下载的...再开个新帖

要学习vba

这个问题.其实在这个帖子里
h加ttp://www.excelpx.com/thread-316405-1-1.html
dongqing1998老师 在6楼有回复过的.
只是 没完全符合要求....

现在 重新开一个新帖..因为原先的帖子要求 轩辕轼轲 老师 已经解答.


附件下载::::::: 28help-1.rar (9.27 KB, 下载次数: 5)

2013-12-29 22:13 上传

点击文件名下载附件

在论坛搜索到的
蓝天630902 老师 的代码:

Sub 重庆时时彩()
    On Error Resume Next
    Dim arr
    With CreateObject("Microsoft.XMLDOM")
        .async = False
        .Load "h加ttp://500wan.zone.tenpay.com/static/public/dlc/xml/historyopen.xml"
        s = .DocumentElement.ChildNodes.Length
        ReDim arr(0 To s, 0 To 6)
        For i = 0 To .DocumentElement.ChildNodes.Length - 1
            Set r = .DocumentElement.ChildNodes.Item(i)
            For J = 0 To r.Attributes.Length - 1
                arr(i, J) = r.Attributes.Item(J).Text
            Next J
        Next i
    End With
    Range(Cells(1, "a"), Cells(s, "F")) = arr
End Sub

效果图:


我想改一下代码.让其实现 D列数据移动到A列,B列保持不变,且B列的数据每行的,号去掉(B列的格式要转换为文本格式,不然会丢数据的.)
最好是能自定义取哪几列数据





XML地址的效果图

最佳答案

月排行榜 / 总排行榜

dongqing1998

2013-12-30 01:03

只需把原来的代码简单改成下面这样就可以了
            arr(i, 2) = Replace(Split(brr(i), """ tian=""")(0), ",", " ")
            arr(i, 1) = Left(Split(brr(i), "expect=""")(1), 8)

1. Sub test()
   
2.     Dim akw rr(1 To 10000, 1 To 2), i&, brr
   
3.     With CreateObject("microsoft.xmlhttp")
   
4.         .Open "GET", "http://500wan.zone.tenpay.com/static/public/dlc/xml/historyopen.xml", False
   
5.         .send
   
6.         Do Until .readystate = 4
   
7.             DoEvents
   
8.         Loop
   
9.         brr = Split(.responsetext, "opencode=""")
   
10.         For i = 1 To UBound(brr)
    
11.             arr(i, 2) = Replace(Split(brr(i), """ tian=""")(0), ",", " ")
    
12.             arr(i, 1) = Left(Split(brr(i), "expect=""")(1), 8)
    
13.         Next
    
14.     End With
    
15.     Cells.ClearContents
    
16.     Range("a1:b" & i) = arr
    
17. End Sub

复制代码

跳转到最佳答案楼层

dongqing1998

只需把原来的代码简单改成下面这样就可以了
            arr(i, 2) = Replace(Split(brr(i), """ tian=""")(0), ",", " ")
            arr(i, 1) = Left(Split(brr(i), "expect=""")(1), 8)

1. Sub test()
   
2.     Dim akw rr(1 To 10000, 1 To 2), i&, brr
   
3.     With CreateObject("microsoft.xmlhttp")
   
4.         .Open "GET", "http://500wan.zone.tenpay.com/static/public/dlc/xml/historyopen.xml", False
   
5.         .send
   
6.         Do Until .readystate = 4
   
7.             DoEvents
   
8.         Loop
   
9.         brr = Split(.responsetext, "opencode=""")
   
10.         For i = 1 To UBound(brr)
    
11.             arr(i, 2) = Replace(Split(brr(i), """ tian=""")(0), ",", " ")
    
12.             arr(i, 1) = Left(Split(brr(i), "expect=""")(1), 8)
    
13.         Next
    
14.     End With
    
15.     Cells.ClearContents
    
16.     Range("a1:b" & i) = arr
    
17. End Sub

复制代码