VBA初试

最新推荐文章于 2022-09-21 23:05:26 发布

舞池大佬&技术小白

最新推荐文章于 2022-09-21 23:05:26 发布

阅读量629

点赞数

文章标签：其他 vba

本文链接：https://blog.csdn.net/qq_31198639/article/details/112675843

版权

本文介绍了如何利用VBA从东财网爬取基金数据，包括实时净值、详细信息和基金经理的相关数据，并展示了修正代码以避免占用剪贴板。

摘要由CSDN通过智能技术生成

为了爬取基金数据做下研究，就研究了一下如何用VBA爬取数据并展示在表格里，以下是成果：

Sub zq()
    Dim url As String, tt As String, bondcode As String, n As Integer
   ' If Not IsEmpty(ActiveSheet.UsedRange) Then ActiveSheet.UsedRange.Clear
      
      n = 1
      '如果第一列的基金代码为空，说明循环完了，停止循环
       Do While Cells(n, 1) <> ""
     
      
 
      With CreateObject("msxml2.xmlhttp")
        'bondcode = Range("A1")
       
        
        bondcode = Cells(n, 1)
       '从表格里取出来的基金代码会少了前面的0，用格式化把0补回来
         bondcode = Format(bondcode, "000000")
        '从接口地址取值
           url = "http://fundgz.1234567.com.cn/js/" + bondcode + ".js"
            .Open "GET", url, False
            .send
            tt = .responsetext
      '  tt = "<table class=""n_table m_table" & Split(Split(tt, "n_table m_table")(1), "</table>")(0) & "</table>"
         
           ' With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
           '     .SetText tt
           '     .PutInClipboard
           ' End With
               tt = Split(Split(tt, "jsonpgz({""")(1), """});")(0)
                arr = Split(tt, """,""")
               '虽然切割出来了但是没有用的一堆变量
               '基金代码
               fundcode = Split(arr(0), ":""")(1)
                '基金名称
                Name = Split(arr(1), ":""")(1)
               '单位净值
                dwjz = Split(arr(3), ":""")(1)
                '估算值
                gsz = Split(arr(4), ":""")(1)
                '估算波动率
                gszzl = Split(arr(5), ":""")(1)
                '日期
                date1 = Split(arr(2), ":""")(1)
                '时间
                date2 = Split(arr(6), ":""")(1)
                '
                date1 = Split(arr(2), ":""")(1)
                '
                date2 = Split(arr(6), ":""")(1)
                
                With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
                .SetText tt
                .PutInClipboard
            End With
        
       ' [B1].Select: ActiveSheet.Paste
        Cells(n, 2).Select: ActiveSheet.Paste
     End With
    n = n + 1
         
    Loop
    MsgBox "获取完毕"
End Sub

上面的URL是获取实时净值的，还有个获取详细数据的接口http://fund.eastmoney.com/pingzhongdata/001186.js?v=20160518155842

2021-01-18更新，发现上述方法会在跑程序的过程中持续占用电脑的剪贴板，所以修改了一下。不知道为啥原作者要通过剪贴板来赋值，我改成了取出相应的值之后直接赋值到单元格。

Sub findData()
    Dim url As String, tt As String, bondcode As String, n As Integer, managerName As String, workTime As String
   ' If Not IsEmpty(ActiveSheet.UsedRange) Then ActiveSheet.UsedRange.Clear
      
      n = 1302
      Do While Cells(n, 2) <> ""
     
      
 
      With CreateObject("msxml2.xmlhttp")
        'bondcode = Range("A1")
       
        
        bondcode = Cells(n, 2)
        bondcode = Format(bondcode, "000000")
        '获取基金实时净值
        'url = "http://fundgz.1234567.com.cn/js/" + bondcode + ".js"
        '获取基金详细数据
        url = "http://fund.eastmoney.com/pingzhongdata/"