Excel中获取股票信息vba

Excel中获取股票信息vba

Excel中获取股票信息vba-LaokNas网络技术笔记
Excel中获取股票信息vba-LaokNas网络技术笔记

Dim sheetnasme As String '股票详情
Dim sheetsuanfei As String '股票算费
Dim number_n As Integer '计数
Sub 股票代码()
'
' 股票代码 宏
'
'StockInfo ("000001")
sheetnasme = "股票详情"
sheetsuanfei = "股票算费"

    If number_n <= 11 Then
        number_n = number_n + 1
    Else
        number_n = 1
    End If
    If sheetnasme = "" Then
    Else
        If Worksheets(sheetnasme).Range("B1").Value = "" Or Len(Worksheets(sheetnasme).Range("B1").Value) < 6 Then
            Worksheets(sheetnasme).Range("B1").Value = "000001"
        Else
            StockInfo (Worksheets(sheetnasme).Range("B1").Value)
        End If
    End If

End Sub


'获取执行查询股票信息
Function StockInfo(code As String)
    StockInfo = 1
    Dim n As Integer
    n = number_n + 2
    Dim url As String, preCode As String
    preCode = Left(code, 1)
    If preCode = "0" Or preCode = "3" Then
    'sz 深圳A股
        url = "http://hq.sinajs.cn/list=sz" + code
    Else
    'sh 上海A股
    url = "http://hq.sinajs.cn/list=sh" + code
    End If
    Dim ret As String
    ret = "11"
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False
        .send
        ret = .responseText
    End With
    'StockInfo = ret
    arr0 = Split(ret, "=")
    arr1 = Split(arr0(1), ",")
    StockInfo = arr1(3)
        
    Worksheets(sheetnasme).Range("A2").Value = "今日开盘价"
    'Worksheets(sheetnasme).Range("A3").Value = arr1(1)
    Worksheets(sheetnasme).Range("A" & n).Value = arr1(1)
    Worksheets(sheetnasme).Range("B2").Value = "昨日收盘价"
    Worksheets(sheetnasme).Range("B" & n).Value = arr1(2)
    Worksheets(sheetnasme).Range("C2").Value = "当前价格"
    Worksheets(sheetnasme).Range("C" & n).Value = arr1(3)
    'Worksheets(sheetsuanfei).Range("E" & "2").Value = arr1(3)
    Worksheets(sheetnasme).Range("D2").Value = "今日最高价"
    Worksheets(sheetnasme).Range("D" & n).Value = arr1(4)
    Worksheets(sheetnasme).Range("E2").Value = "今日最低价"
    Worksheets(sheetnasme).Range("E" & n).Value = arr1(5)
    Worksheets(sheetnasme).Range("F2").Value = "竞买价(买一报价)"
    Worksheets(sheetnasme).Range("F" & n).Value = arr1(6)
    Worksheets(sheetnasme).Range("G2").Value = "竞卖价(卖一报价)"
    Worksheets(sheetnasme).Range("G" & n).Value = arr1(7)
    Worksheets(sheetnasme).Range("H2").Value = "成交股数(100)"
    Worksheets(sheetnasme).Range("H" & n).Value = arr1(8) / 100
    Worksheets(sheetnasme).Range("I2").Value = "成交金额(万元)"
    Worksheets(sheetnasme).Range("I" & n).Value = arr1(9) / 10000
    Worksheets(sheetnasme).Range("J2").Value = "买家"
    Worksheets(sheetnasme).Range("K2").Value = "报价"
    Worksheets(sheetnasme).Range("L2").Value = "股数100"
    Worksheets(sheetnasme).Range("J3").Value = "买一"
    Worksheets(sheetnasme).Range("K3").Value = arr1(11) '报价
    Worksheets(sheetnasme).Range("L3").Value = arr1(10) / 100 '股数
    Worksheets(sheetnasme).Range("J4").Value = "买二"
    Worksheets(sheetnasme).Range("K4").Value = arr1(13) '报价
    Worksheets(sheetnasme).Range("L4").Value = arr1(12) / 100 '股数
    Worksheets(sheetnasme).Range("J5").Value = "买三"
    Worksheets(sheetnasme).Range("K5").Value = arr1(15) '报价
    Worksheets(sheetnasme).Range("L5").Value = arr1(14) / 100 '股数
    Worksheets(sheetnasme).Range("J6").Value = "买四"
    Worksheets(sheetnasme).Range("K6").Value = arr1(17) '报价
    Worksheets(sheetnasme).Range("L6").Value = arr1(16) / 100 '股数
    Worksheets(sheetnasme).Range("J7").Value = "买五"
    Worksheets(sheetnasme).Range("K7").Value = arr1(19) '报价
    Worksheets(sheetnasme).Range("L7").Value = arr1(18) / 100 '股数
    Worksheets(sheetnasme).Range("J9").Value = "卖家"
    Worksheets(sheetnasme).Range("K9").Value = "报价"
    Worksheets(sheetnasme).Range("L9").Value = "股数100"
    Worksheets(sheetnasme).Range("J10").Value = "卖一"
    Worksheets(sheetnasme).Range("K10").Value = arr1(21) '报价
    Worksheets(sheetnasme).Range("L10").Value = arr1(20) / 100 '股数
    Worksheets(sheetnasme).Range("J11").Value = "卖二"
    Worksheets(sheetnasme).Range("K11").Value = arr1(23) '报价
    Worksheets(sheetnasme).Range("L11").Value = arr1(22) / 100 '股数
    Worksheets(sheetnasme).Range("J12").Value = "卖三"
    Worksheets(sheetnasme).Range("K12").Value = arr1(25) '报价
    Worksheets(sheetnasme).Range("L12").Value = arr1(24) / 100 '股数
    Worksheets(sheetnasme).Range("J13").Value = "卖四"
    Worksheets(sheetnasme).Range("K13").Value = arr1(27) '报价
    Worksheets(sheetnasme).Range("L13").Value = arr1(26) / 100 '股数
    Worksheets(sheetnasme).Range("J14").Value = "卖五"
    Worksheets(sheetnasme).Range("K14").Value = arr1(29) '报价
    Worksheets(sheetnasme).Range("L14").Value = arr1(28) / 100 '股数
    Worksheets(sheetnasme).Range("J1").Value = arr1(30) & " " & arr1(31) '日期时间
    Worksheets(sheetnasme).Range("C1").Value = Mid(arr1(0), 2, Len(arr1(0)))
    'Worksheets(sheetsuanfei).Range("C2").Value = Mid(arr1(0), 2, Len(arr1(0)))
    'Worksheets(sheetnasme).Range("C1").Value = Len(arr1(0) + 1)
    
    If Worksheets(sheetnasme).Range("O2").Value = "on" Then
    
        Worksheets(sheetnasme).Range("A" & n - 1 & ":I" & n - 1).Select
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        
        Worksheets(sheetnasme).Range("A" & n & ":I" & n).Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent2
            .TintAndShade = 0.399975585192419
            .PatternTintAndShade = 0
        End With
        
        Worksheets(sheetnasme).Range("A" & n + 1 & ":I" & n + 1).Select
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        Worksheets(sheetnasme).Range("A" & n & ":I" & n).Select
    Else

    End If
End Function


'自动刷新3s每次
Function Freshtime()
Dim NewTime As Date
NewTime = Now + TimeValue("00:00:3")
Calculate
Application.OnTime NewTime, "Freshtime"



'启动执行股票
Call 股票代码

Worksheets(sheetnasme).Range("G1").Value = "运行:" & " " & NewTime

End Function


'启动自动刷新执行
Sub 自动刷新()
Call Freshtime
End Sub

Sub 实时查询()

' 股票代码 宏
'
'StockInfo ("000001")
'sheetnasme = "股票算费"
sheetsuanfei = "股票算费"
Dim sheet_str2 As String
Dim sheet_str3 As String
Dim sheet_str4 As String
Dim sheet_str5 As String
Dim sheet_str6 As String
Dim sheet_str7 As String
Dim sheet_str8 As String
Dim sheet_str9 As String
Dim sheet_str10 As String
Dim sheet_str11 As String

    If sheetsuanfei = "" Then
    
    Worksheets(sheetsuanfei).Range("k1").Value = "错误"
    Else
        If Worksheets(sheetsuanfei).Range("B2").Value <> "" And Len(Worksheets(sheetsuanfei).Range("B1").Value) = 6 Then sheet_str2 = StockInfo_sisi(2, Worksheets(sheetsuanfei).Range("B2").Value)
        If Worksheets(sheetsuanfei).Range("B3").Value <> "" And Len(Worksheets(sheetsuanfei).Range("B1").Value) = 6 Then sheet_str3 = StockInfo_sisi(3, Worksheets(sheetsuanfei).Range("B3").Value)
        If Worksheets(sheetsuanfei).Range("B4").Value <> "" And Len(Worksheets(sheetsuanfei).Range("B1").Value) = 6 Then sheet_str4 = StockInfo_sisi(4, Worksheets(sheetsuanfei).Range("B4").Value)
        If Worksheets(sheetsuanfei).Range("B5").Value <> "" And Len(Worksheets(sheetsuanfei).Range("B1").Value) = 6 Then sheet_str5 = StockInfo_sisi(5, Worksheets(sheetsuanfei).Range("B5").Value)
        If Worksheets(sheetsuanfei).Range("B6").Value <> "" And Len(Worksheets(sheetsuanfei).Range("B1").Value) = 6 Then sheet_str6 = StockInfo_sisi(6, Worksheets(sheetsuanfei).Range("B6").Value)
        If Worksheets(sheetsuanfei).Range("B7").Value <> "" And Len(Worksheets(sheetsuanfei).Range("B1").Value) = 6 Then sheet_str7 = StockInfo_sisi(7, Worksheets(sheetsuanfei).Range("B7").Value)
        If Worksheets(sheetsuanfei).Range("B8").Value <> "" And Len(Worksheets(sheetsuanfei).Range("B1").Value) = 6 Then sheet_str8 = StockInfo_sisi(8, Worksheets(sheetsuanfei).Range("B8").Value)
        If Worksheets(sheetsuanfei).Range("B9").Value <> "" And Len(Worksheets(sheetsuanfei).Range("B1").Value) = 6 Then sheet_str9 = StockInfo_sisi(9, Worksheets(sheetsuanfei).Range("B9").Value)
        If Worksheets(sheetsuanfei).Range("B10").Value <> "" And Len(Worksheets(sheetsuanfei).Range("B1").Value) = 6 Then sheet_str10 = StockInfo_sisi(10, Worksheets(sheetsuanfei).Range("B10").Value)
        If Worksheets(sheetsuanfei).Range("B11").Value <> "" And Len(Worksheets(sheetsuanfei).Range("B1").Value) = 6 Then sheet_str11 = StockInfo_sisi(11, Worksheets(sheetsuanfei).Range("B11").Value)

    End If
   
    

End Sub


'自动刷新3s每次
Function Freshtime_01()
Dim NewTime As Date
NewTime = Now + TimeValue("00:00:3")
Calculate
Application.OnTime NewTime, "Freshtime"

'启动执行股票
Call 实时查询


End Function


'获取执行查询股票信息
Function StockInfo_sisi(str As String, code As String)

If str = 2 Then

    StockInfo_sisi = 1

    Dim url As String, preCode As String
    preCode = Left(code, 1)
    If preCode = "0" Or preCode = "3" Then
    'sz 深圳A股
        url = "http://hq.sinajs.cn/list=sz" + code
    Else
    'sh 上海A股
    url = "http://hq.sinajs.cn/list=sh" + code
    End If
    Dim ret As String
    ret = "11"
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False
        .send
        ret = .responseText
    End With
    'StockInfo = ret
    arr0 = Split(ret, "=")
    arr1 = Split(arr0(1), ",")
    StockInfo_sisi = arr1(3)
        
Worksheets(sheetsuanfei).Range("E" & str).Value = arr1(3)
Else
Worksheets(sheetsuanfei).Range("k" & str).Value = "错误"

    End If
    
End Function

Sina股票数据接口:

http://hq.sinajs.cn/list=sz000001  var hq_str_sh601006=”平安银行, 17.55, 17.25, 16.91, 17.55, 16.20, 16.91, 16.92, 79114263, 1398124681, 4695, 16.91, 57590, 16.90, 14700, 21.89, 14300, 16.88, 15100, 16.87, 3100, 16.92, 8900, 16.93, 14230, 16.94, 25150, 16.95, 15220, 16.96, 2021-12-11, 15:05:32”;

查看日K线图: http://image.sinajs.cn/newchart/daily/n/sz000001.gif

Excel中获取股票信息vba-LaokNas网络技术笔记

分时线的查询: http://image.sinajs.cn/newchart/min/n/sz000001.gif

Excel中获取股票信息vba-LaokNas网络技术笔记

日K线查询: http://image.sinajs.cn/newchart/daily/n/sh000001.gif

Excel中获取股票信息vba-LaokNas网络技术笔记

周K线查询: http://image.sinajs.cn/newchart/weekly/n/sh000001.gif

Excel中获取股票信息vba-LaokNas网络技术笔记

月K线查询: http://image.sinajs.cn/newchart/monthly/n/sh000001.gif

Excel中获取股票信息vba-LaokNas网络技术笔记
© 版权声明
THE END
喜欢就支持一下吧
点赞0 分享
评论 抢沙发
头像
欢迎您留下宝贵的见解!
提交
头像

昵称

取消
昵称表情代码图片

    暂无评论内容