历史行情数据

免费接口稀少

1.sohu的

https://q.stock.sohu.com/hisHq?code=cn_601766&start=20250529&end=20250613

[{"status":0,"hq":[["2025-06-13","7.14","7.22","0.08","1.12%","7.12","7.22","685514","49244.04","0.28%"],["2025-06-12","7.15","7.14","-0.02","-0.28%","7.10","7.17","428634","30575.59","0.18%"],["2025-06-11","7.12","7.16","0.05","0.70%","7.11","7.21","525410","37721.62","0.22%"],["2025-06-10","7.17","7.11","-0.08","-1.11%","7.10","7.21","521624","37293.61","0.21%"],["2025-06-09","7.18","7.19","0.01","0.14%","7.17","7.24","405410","29182.58","0.17%"],["2025-06-06","7.17","7.18","0.01","0.14%","7.16","7.22","403923","29047.88","0.17%"],["2025-06-05","7.15","7.17","0.02","0.28%","7.11","7.20","462632","33109.76","0.19%"],["2025-06-04","7.20","7.15","-0.06","-0.83%","7.14","7.22","553423","39723.53","0.23%"],["2025-06-03","7.18","7.21","0.01","0.14%","7.16","7.24","465032","33476.17","0.19%"],["2025-05-30","7.24","7.20","-0.05","-0.69%","7.17","7.26","530172","38242.01","0.22%"],["2025-05-29","7.23","7.25","0.02","0.28%","7.22","7.29","461504","33503.35","0.19%"]],"code":"cn_601766"}]

在浏览器中可以，在代码中不行

2.新浪的

http://finance.sina.com.cn/realstock/company/sz002095/qianfuquan.js?d=2015-06-16

[{total:4527,data:{_2025_08_01:"1.467729",_2025_07_31:"1.462737",_2025_07_30:"1.474148",_2025_07_29:"1.523357",_2025_07_28:"1.539760",_2025_07_25:"1.525497",_2025_07_24:"1.504815",_2025_07_23:"1.499822",_2025_07_22:"1.537621",_2025_07_21:

数据也取到了，发现问题，一是只能是前复权或者后复权，我需要不复权的数据；二是即使是前复权数据，也不准确。我算了一下，和真实数据存在比例关系，但具体算法不清楚。

看来，通过老式的api接口取数据，实在太难了。

代码留下：

Sub GetHistoryPrice(code As String)  '获取指定股票的历史价格，新浪
     Dim xmlobject As Object
     Dim strReturn As String
     Dim strUrl As String
     Dim intLen As Long
     Dim intLenA As Long
     Dim arry As Variant
     Dim vol(10) As Long
     Dim dd As Date
     Dim p1 As Long
     Dim hang As Integer  '行数
     Set xmlobject = CreateObject("microsoft.xmlhttp")
     hang = ActiveSheet.UsedRange.Rows.Count - 1
     strUrl = "http://finance.sina.com.cn/realstock/company/" & code & "/qianfuquan.js"
     xmlobject.Open "GET", strUrl, False
     xmlobject.send
     If xmlobject.readystate = 4 Then
         strReturn = xmlobject.responsetext
         For i = 1 To hang       '遍历，10等于当前行数
             dd = Cells(i + 1, 2)
             Do While True
               p1 = InStr(strReturn, Format(dd, "yyyy_mm_dd"))
               If p1 > 0 Then Exit Do
               dd = DateAdd("d", 1, dd)
             Loop
             If p1 > 0 Then
                 p2 = InStr(p1, strReturn, """")
                 p3 = InStr(p2 + 1, strReturn, """")
                 ss = Mid(strReturn, p2 + 1, p3 - p2)
                 Cells(1 + i, 3) = Mid(strReturn, p2 + 1, p3 - p2 - 1)
             End If
         Next i
     End If
End Sub

Sub GetHistoryPrice_sohu(code As String, dd As Date) '获取指定股票的历史价格，搜狐
     Dim xmlobject As Object
     Dim strReturn As String
     Dim strUrl As String
     Dim intLen As Long
     Dim intLenA As Long
     Dim arry As Variant
     Dim vol(10) As Long
     'Set xmlobject = CreateObject("microsoft.xmlhttp")
     Set xmlobject = CreateObject("WinHttp.WinHttpRequest.5.1")
     'xmlobject?option(9) = 2720
     Dim p1 As Integer
     Dim hang As Integer  '行数
     hang = ActiveSheet.UsedRange.Rows.Count - 1
       '写入持仓表
     For i = 1 To hang       '遍历，10等于当前行数
             strUrl = "http://q.stock.sohu.com/hisHq?code=cn_" & code & "&start=" & Format(DateAdd("d", -12, dd), "yyyymmdd") & "&end=" & Format(DateAdd("d", 11, dd), "yyyymmdd") '起始代码单元格
             xmlobject.Open "GET", strUrl, False
             xmlobject.send
             If xmlobject.readystate = 4 Then
                 strReturn = xmlobject.responsetext
                 intLen = Len(strReturn) - 25 '剔除无关数据
                 strReturn = Mid(strReturn, 22, intLen)
                 p1 = InStr(strReturn, dd)
                 If p1 > 0 Then
                     strReturn = Mid(strReturn, p1)
                     arry = Split(strReturn, ",") '按逗号分隔数据，放入数组arry
                    '获取目标数据
                    Cells(1 + i, 3) = arry(2) '现值
                 End If
             End If
     Next i
End Sub