VBA实时提取股票资金流入TOP

本文链接： https://blog.csdn.net/qq_44390640/article/details/102587426
下是根据和讯网实时提取资金流入股票的TOP情况
Sub 实时提取股票资金流入TOP()


    Dim tmp(), TEMP1(), S, STR, STR_1, STR_2 As String, arr() As String, xmlhttp As Object, I, J, N As Long

    Worksheets("实时资金流入统计").Cells.Clear
    Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
    With xmlhttp
        .Open "get", "http://vol.stock.hexun.com/Data/Stock/StkRankDetail.ashx?groupby=254&addby=&plate=1&count=200&stateType=down&titType=4&page=1&callback=hx_json1571189903546788006 ", False
        'http://vol.stock.hexun.com/Data/Stock/StkRankDetail.ashx?groupby=254&addby=&plate=1&count=20&stateType=down&titType=4&page=1&pagesize=100&callback=hx_json1571189903546788006
        .send
        S = .responsetext
        End With
       
Worksheets("实时资金流入统计").Range("A1:J1") = Array("序号", "股票代码/名称", "最新价", "涨跌幅", "资金净流入(万元)", "机构资金流入(万元)", "机构资金流入率", "机构资金净流入率", "机构资金流入占成交(%)", "备注")
STR_1 = Split(Split(S, "[")(1), "},")


For I = 0 To UBound(STR_1)
   STR = STR_1(I)
   STR_NEW = Split(STR, ",")
   
    J = UBound(Split(STR, ","))
    STR_NEW_1 = Replace(Replace(STR_NEW(0), "{data0:'", ""), "'", "")
    STR_NEW_2 = Replace(Replace(STR_NEW(1), "data1:'", ""), "'", "")
    
    STR_NEW_3 = Split(Split(STR_NEW(2), ">")(1), "<")(0)
    STR_NEW_4 = Split(Split(STR_NEW(3), ">")(1), "<")(0)
    STR_NEW_5 = Split(Split(STR_NEW(4), ">")(1), "<")(0)
    STR_NEW_6 = Split(Split(STR_NEW(5), ">")(1), "<")(0)
    STR_NEW_7 = Split(Split(STR_NEW(6), ">")(1), "<")(0)
    STR_NEW_8 = Split(Split(STR_NEW(7), ">")(1), "<")(0)
    STR_NEW_11 = Split(Split(STR_NEW(10), ">")(1), "<")(0)
   ' str_new_9 = STR_NEW(8)
    Worksheets("实时资金流入统计").Cells(I + 2, 1) = STR_NEW_1
    Worksheets("实时资金流入统计").Cells(I + 2, 2) = STR_NEW_2
    Worksheets("实时资金流入统计").Cells(I + 2, 3) = STR_NEW_3
    Worksheets("实时资金流入统计").Cells(I + 2, 4) = STR_NEW_4
    Worksheets("实时资金流入统计").Cells(I + 2, 5) = STR_NEW_5
    Worksheets("实时资金流入统计").Cells(I + 2, 6) = STR_NEW_6
    Worksheets("实时资金流入统计").Cells(I + 2, 7) = STR_NEW_7
    Worksheets("实时资金流入统计").Cells(I + 2, 8) = STR_NEW_8
    Worksheets("实时资金流入统计").Cells(I + 2, 9) = STR_NEW_11
     If Worksheets("实时资金流入统计").Cells(I + 2, 9) > 80 Then
     Worksheets("实时资金流入统计").Cells(I + 2, 9).Interior.ColorIndex = 3
     Worksheets("实时资金流入统计").Cells(I + 2, 10) = "有机构高度控股"
     ElseIf Worksheets("实时资金流入统计").Cells(I + 2, 9) > 50 Then
      Worksheets("实时资金流入统计").Cells(I + 2, 9).Interior.ColorIndex = 6
      Worksheets("实时资金流入统计").Cells(I + 2, 10) = "有机构控股"
     End If

Next
Worksheets("实时资金流入统计").Activate
Worksheets("实时资金流入统计").Range("A1").CurrentRegion.Columns.AutoFit


MsgBox ("OK")
End Sub
运行结果如下：
在这里插入图片描述
VBA实时提取股票资金流入TOP

猜你喜欢
