来jisilu很多年了,给大家贡献一个自己用的基于新浪行情接口和VBA的Excel股票行情抓取模板。Excel模板在本贴附件里面,2017-2023年已经免费分享了5、6年,自现在起,取消免费分享.
一、解决的痛点:
1、自动抓取股票行情,避免手工跟踪股票价格、市值的麻烦。
2、避免股票行情软件花花绿绿的界面(懂得)
3、自定义各种公式
二、主要功能:
1、可获取A股指数、个股、转债、基金、港股(港股有可能是延时的) 行情
2、定时(30秒,可修改)刷新功能
3、增加修改需要关心的个股非常方便(不需要编程能力)
三、应用场景举例
1、持仓市值跟踪:手工在本Excel中输入持仓数量,借助实时行情刷新,可创建自己的实时市值、仓位管理功能。
2、转债溢价率跟踪:抓取转债价格、正股价格,可利用excel功能实时跟踪转债溢价率。
3、分级基金合并溢价跟踪:以上海分级为例,抓取A、B和母鸡价格,可跟踪分级基金合并溢价。
四、安全性
1、源代码VBA开放,可自行检查
五、运行条件:
1、Excel上要开放“宏”运行权限(一般性Excel会有提示)
2、版本问题申明:在本人Office家庭和学生版Excel上运行正常,本人WPS版本上运行正常。
六、免责声明
1、本excel免费使用,本人不承担因使用、复制、传播此excel及其相关功能造成的任何损失
2、由于使用者电脑设置及excel软件版本,可能造成运行不正常,此问题我无法控制,只能用户自行解决。从实际大约50+用户反馈来看,反映无法正常运行的用户极少(少于5%)
七、下载链接
若看官确有需要,请仔细阅读并接受以下条款,1、本人提供的模板仅为个人之间学习使用,不允许用于商业用途,交付后不承诺任何后续技术支持服务,也不接受退款,不对后续使用赴任何责任。 2、打赏10金币即视为接受上述条款,接到打赏后我会通过jisilu私信,提供百度网盘下载链接
-------------------------
历史变更记录:
20220121新浪接口变更,紧急消缺更新到4.0版本
20230730 取消免费分享,改为打赏后提供网盘链接(现已过期)
20230812公告 。感谢各位的关注,由于收到jisilu后台提醒“请不要在社区做任何形式的营销推广”,出于对jisilu的尊重,即日起停止在本贴分享行情抓取模板的下载链接。各位朋友若确有需要,可以pm联系沟通
自己用的,所以比较简陋。如有不明,可回帖或私信联系。
致谢:
1、这个方法参考了jisilu里面很多同学的帖子,特别感谢islq同学在https://www.jisilu.cn/question/2230帖子里面提供的excel样例.
2、致谢20220121 欣财富自由之路@jisilu网友提供的新浪接口修复代码
一、解决的痛点:
1、自动抓取股票行情,避免手工跟踪股票价格、市值的麻烦。
2、避免股票行情软件花花绿绿的界面(懂得)
3、自定义各种公式
二、主要功能:
1、可获取A股指数、个股、转债、基金、港股(港股有可能是延时的) 行情
2、定时(30秒,可修改)刷新功能
3、增加修改需要关心的个股非常方便(不需要编程能力)
三、应用场景举例
1、持仓市值跟踪:手工在本Excel中输入持仓数量,借助实时行情刷新,可创建自己的实时市值、仓位管理功能。
2、转债溢价率跟踪:抓取转债价格、正股价格,可利用excel功能实时跟踪转债溢价率。
3、分级基金合并溢价跟踪:以上海分级为例,抓取A、B和母鸡价格,可跟踪分级基金合并溢价。
四、安全性
1、源代码VBA开放,可自行检查
五、运行条件:
1、Excel上要开放“宏”运行权限(一般性Excel会有提示)
2、版本问题申明:在本人Office家庭和学生版Excel上运行正常,本人WPS版本上运行正常。
六、免责声明
1、本excel免费使用,本人不承担因使用、复制、传播此excel及其相关功能造成的任何损失
2、由于使用者电脑设置及excel软件版本,可能造成运行不正常,此问题我无法控制,只能用户自行解决。从实际大约50+用户反馈来看,反映无法正常运行的用户极少(少于5%)
七、下载链接
若看官确有需要,请仔细阅读并接受以下条款,1、本人提供的模板仅为个人之间学习使用,不允许用于商业用途,交付后不承诺任何后续技术支持服务,也不接受退款,不对后续使用赴任何责任。 2、打赏10金币即视为接受上述条款,接到打赏后我会通过jisilu私信,提供百度网盘下载链接
-------------------------
历史变更记录:
20220121新浪接口变更,紧急消缺更新到4.0版本
20230730 取消免费分享,改为打赏后提供网盘链接(现已过期)
20230812公告 。感谢各位的关注,由于收到jisilu后台提醒“请不要在社区做任何形式的营销推广”,出于对jisilu的尊重,即日起停止在本贴分享行情抓取模板的下载链接。各位朋友若确有需要,可以pm联系沟通
自己用的,所以比较简陋。如有不明,可回帖或私信联系。
致谢:
1、这个方法参考了jisilu里面很多同学的帖子,特别感谢islq同学在https://www.jisilu.cn/question/2230帖子里面提供的excel样例.
2、致谢20220121 欣财富自由之路@jisilu网友提供的新浪接口修复代码
0
@天书
刚才根据jisilu网友要求,在本贴发布的excel文件中,增加了4个功能函数(开盘价/最高价/最低价/成交总量),在电脑网页版上使用帖子编辑功能,把老的excel附件删除了,却发现新的excel传不上去,一直提示“文件类型无效”。能否帮忙解决下?
刚才根据jisilu网友要求,在本贴发布的excel文件中,增加了4个功能函数(开盘价/最高价/最低价/成交总量),在电脑网页版上使用帖子编辑功能,把老的excel附件删除了,却发现新的excel传不上去,一直提示“文件类型无效”。能否帮忙解决下?
0
楼主及众集友:
我很喜欢这样的适用工具,适用并添加了自己关注的股票。
但是有没有遇到同样问题的,windows10提示木马病毒,trojan:script/oneeva.a!ml。最近己次反复删除。
不知道是否真的病毒,哪个环节感染到病毒。
我下载后,自己另起一页遍了一些简单的公式,提示自己关注的股票分位值。
我很喜欢这样的适用工具,适用并添加了自己关注的股票。
但是有没有遇到同样问题的,windows10提示木马病毒,trojan:script/oneeva.a!ml。最近己次反复删除。
不知道是否真的病毒,哪个环节感染到病毒。
我下载后,自己另起一页遍了一些简单的公式,提示自己关注的股票分位值。
0
大神可以帮忙看看这个怎么添加一个30秒自动更新,麻烦了
Function FillOneRow(url As String, r As Integer) As Integer
With CreateObject("msxml2.xmlhttp")
.Open "GET", url, False
.send
sp = Split(.responsetext, "~")
If UBound(sp) > 3 Then
FillOneRow = 1
Cells(r, 2).Value = sp(1) '名称
Cells(r, 3).Value = sp(3) '当前价格
Cells(r, 4).Value = sp(4) '昨日收盘价
Dim zhangDie As Double
zhangDie = sp(32)
Cells(r, 5).Value = zhangDie
If zhangDie > 0 Then
'上涨使用红色
Cells(r, 5).Font.Color = vbRed
Cells(r, 3).Font.Color = vbRed
Else
'下跌使用绿色
Cells(r, 5).Font.Color = &H228B22
Cells(r, 3).Font.Color = &H228B22
End If
Else
FillOneRow = 0
End If
End With
End Function
Sub GetData()
Application.ScreenUpdating = False
Dim succeeded As Integer
Dim url As String
Dim row As Integer
Dim code As String
For row = 2 To Range("A1").CurrentRegion.Rows.Count '从第二行开始
code = Cells(row, 1).Value
If code = "000001" Then
url = "http://qt.gtimg.cn/q=sh" & code '沪市
succeeded = FillOneRow(url, row)
End If
Next
For row = 3 To Range("A1").CurrentRegion.Rows.Count '从第三行开始
code = Cells(row, 1).Value
If code <> "" Then
url = "http://qt.gtimg.cn/q=sz" & code '深市
succeeded = FillOneRow(url, row)
If succeeded = 0 Then
url = "http://qt.gtimg.cn/q=sh" & code '沪市
succeeded = FillOneRow(url, row)
End If
If succeeded = 0 Then
MsgBox ("获取失败")
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Function FillOneRow(url As String, r As Integer) As Integer
With CreateObject("msxml2.xmlhttp")
.Open "GET", url, False
.send
sp = Split(.responsetext, "~")
If UBound(sp) > 3 Then
FillOneRow = 1
Cells(r, 2).Value = sp(1) '名称
Cells(r, 3).Value = sp(3) '当前价格
Cells(r, 4).Value = sp(4) '昨日收盘价
Dim zhangDie As Double
zhangDie = sp(32)
Cells(r, 5).Value = zhangDie
If zhangDie > 0 Then
'上涨使用红色
Cells(r, 5).Font.Color = vbRed
Cells(r, 3).Font.Color = vbRed
Else
'下跌使用绿色
Cells(r, 5).Font.Color = &H228B22
Cells(r, 3).Font.Color = &H228B22
End If
Else
FillOneRow = 0
End If
End With
End Function
Sub GetData()
Application.ScreenUpdating = False
Dim succeeded As Integer
Dim url As String
Dim row As Integer
Dim code As String
For row = 2 To Range("A1").CurrentRegion.Rows.Count '从第二行开始
code = Cells(row, 1).Value
If code = "000001" Then
url = "http://qt.gtimg.cn/q=sh" & code '沪市
succeeded = FillOneRow(url, row)
End If
Next
For row = 3 To Range("A1").CurrentRegion.Rows.Count '从第三行开始
code = Cells(row, 1).Value
If code <> "" Then
url = "http://qt.gtimg.cn/q=sz" & code '深市
succeeded = FillOneRow(url, row)
If succeeded = 0 Then
url = "http://qt.gtimg.cn/q=sh" & code '沪市
succeeded = FillOneRow(url, row)
End If
If succeeded = 0 Then
MsgBox ("获取失败")
End If
End If
Next
Application.ScreenUpdating = True
End Sub
2
赞同来自: jsl6165 、wangliang99
不绑定手机还评论不了,为了谢谢博主,特意绑定啦手机
非常感谢,这是我一直想要的功能,而且可以取到场外的指数基金净值,棒棒哒
场外基金的净值取到的是累计净值,略微改了一下就可以取单位净值啦
非常好用,多谢多谢
非常感谢,这是我一直想要的功能,而且可以取到场外的指数基金净值,棒棒哒
场外基金的净值取到的是累计净值,略微改了一下就可以取单位净值啦
非常好用,多谢多谢