通过VBA在excel中实现股票历史数据查询和K线趋势图绘制（完整的excel原件可以在我的资源中下载）

已于 2022-08-31 08:16:48 修改
阅读量4.2k 收藏 14
点赞数 3
分类专栏： 自动化办公 文章标签： excel vba python 算法
于 2022-08-21 17:16:27 首次发布
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/weitingfu/article/details/126452537
版权

原始文件下载地址：股票历史数据和K线图趋势线的绘制-VB文档类资源-CSDN下载

前言

虽然现在各种股票APP都可以轻松查看股票K线图，但是自动生成趋势图却常常需要收费，因此考虑自己用excel做一个股票K线和趋势图的表格，可以通过股票代码和简单的设置，生成股票K线图和趋势图。

一、目标

1、根据股票代码查询历史数据；

2、根据历史数据绘制K线图和高低点趋势图。

二、方法

1、通过VBA程序，从网络上获取股票的历史数据；

2、通过VBA程序，选取需要的天数的数据，绘制K线图和趋势线。

三、界面和使用说明

1、在代码后输入股票代码；

2、设定缩放比例（缩放比例应与估价对应，估价高时，比例低，估价低时，比例高，以便画出的K线图更好看）；

3、选择需要绘制K线的天数；

4、点击“更新数据”按钮，自动运行VBA宏程序，查询历史数据并绘制K线图和趋势图。

四、代码说明

1.查询历史数据

代码如下：

Sub 历史数据查询()
    Dim t
    t = Timer  '计时开始
    
    Dim x As Long
    Dim y As Long
    Dim I As Long
    
    Application.ScreenUpdating = False '关闭屏幕更新，提升速度
    
    [2:65536] = "" '清除3-65536行的数据
    
    x = Application.CountA(Worksheets("历史数据").Range("E1:E1"))  '计算代码的数量
    For I = 2 To x + 1
        'Worksheets("历史数据").Cells(1, (3 + I)) = "'" & Right(Worksheets("代码").Cells(I, 1), 6)
        
        y = Application.CountA(Worksheets("历史数据").Range("A1:A65536")) + 1 '计算已有内容的行的数量
        
        wy = IIf(Worksheets("历史数据").Cells(1, (3 + I)) < 600000, "1", "0") & Worksheets("历史数据").Cells(1, (3 + I)) '根据A列单元格中的代码查询历史数据
        wy = "http://quotes.money.163.com/service/chddata.html?code=" & wy   '组成网络地址
   
        With ActiveSheet.QueryTables.Add(Connection:="URL;" & wy, Destination:=Range("A" & (1 + y)))  '使用with函数获取历史数据
         .Refresh 0
        End With
        
    Next I

    
    Cells(2, 17) = "阶段低点"
    Cells(2, 18) = "阶段高点"
    
    [A:A].Replace "None", ""   '用空白替换None
    Range("a2:a65536").TextToColumns [a2], 1, , , , , 1   '数据分列显示
    [A:P].Columns.AutoFit
    

    Call 生成K线图
    
    Application.ScreenUpdating = True '打开屏幕更新
    MsgBox "   共耗时：" & WorksheetFunction.Text(Timer - t, "0.00秒")    '显示程序执行用时
    
End Sub

（1）统计程序执行用时，并以弹窗形式显示

代码如下：

Dim t
t = Timer

（程序主体）

MsgBox "   共耗时：" & WorksheetFunction.Text(Timer - t, "0.00秒")    '显示程序执行用时

 （2）数据分列和自动调整列宽

代码如下：

Range("a2:a65536").TextToColumns [a2], 1, , , , , 1   '数据分列显示
[A:P].Columns.AutoFit '自动调整A列到P列的列宽

2.绘制K线图和趋势线

代码如下：

Sub 生成K线图()
    '定义变量
    Dim X0, X1, I, Lx, Ly, k, Highprice, Lowprice
    Dim Fy1, rFx1, rFy1
    Dim Arr
    Dim shp As Object
    
    '清空单元格内的数据
    [Q3:Z400] = ""
    
    '确定数据源
    EndRow = Cells(1, 9)          '统计有数据的最后一行的行号
    Arr = Range("A1", Cells(EndRow, "I"))   '数据源
    
    '确定波段的高低点
    Highprice = Cells(3, 5)
    Lowprice = Cells(3, 6)
    
    If Cells(3, 4) > Cells(3, 7) Then       '如果最后一天的收盘价大于开盘价，则当天保留最高价，否则保留最低价
        Cells(3, 18) = Highprice
    Else
        Cells(3, 17) = Lowprice
    End If
    
    For j = 4 To EndRow
        '获取高点
        If (Cells(j, 5) > Cells(j - 1, 5)) * (Cells(j, 5) > Cells(j + 1, 5)) Then '如果当日最高点大于前一日和后一日的最高点
            Cells(j, 18) = Cells(j, 5)  '将当日数据填入对应高点数据列
            
        End If
            
        If (j > 8) Then
            '当日最高点为前2日到后3日的最高点时，将当日数据填入对应高点数据列，否则清除对应数据列单元格数据
            If (Cells(j, 5) = Application.WorksheetFunction.Max(Range(Cells(j - 2, 5), Cells(j + 3, 5)))) Then
                Cells(j, 18) = Cells(j, 5)
            Else
                Cells(j, 18) = ""
            End If
        End If
        
        '获取低点
        If (Cells(j, 6) < Cells(j - 1, 6)) * (Cells(j, 6) < Cells(j + 1, 6)) Then
            Cells(j, 17) = Cells(j, 6)
            
        End If
            
        If (j > 8) Then
            If (Cells(j, 6) = Application.WorksheetFunction.Min(Range(Cells(j - 2, 6), Cells(j + 3, 6)))) Then
                Cells(j, 17) = Cells(j, 6)
            Else
                Cells(j, 17) = ""
            End If
        End If
               
    Next j
    
    
    '此处省略部分核心程序，需要请到我的资源下载源文件

        
    '开始绘制K线和趋势线
    '变量赋初值
    X0 = 1000                                'X0=距离表格最左侧的距离，表示第一条K线在水平方向上的起始位置
    
    k = Cells(1, 7)                         'k=Y轴的缩放比例
    Y0 = Application.WorksheetFunction.Max(Range(Cells(3, 5), Cells(EndRow, 5))) * k + 5 * k  'Y0=距离表格最顶部的距离，表示第一条K线在竖直方向上的起始位置
    
    '清除原有图形
    For Each S In ActiveSheet.Shapes
        If S.Type <> 8 Then            '有插入一个窗体控件指定宏
            S.Delete                   '把不是窗体控件的shape（图片、图形等）清除
        End If
    Next S
    
    For I = 3 To EndRow

        X1 = 7 * I                          'X1表示K线之间的水平间距
        Lx = X0 + X1                        'Lx表示K线对应的水平坐标
        
        '绘制K线
        ActiveSheet.Shapes.AddLine Lx, Y0 - Arr(I, 6) * k, Lx, Y0 - Arr(I, 5) * k    'AddLine (BeginX、 BeginY、 EndX、 EndY)，画一条从最低价Arr(I, 6)到最高价Arr(I, 5)的竖线
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, X0 + X1 - 1.5, Y0 - WorksheetFunction.Max(Arr(I, 4), _
            Arr(I, 7)) * k, 3, Abs(Arr(I, 4) - Arr(I, 7)) * k).Select                '画一条从开盘价到收盘价的柱状线，并选中
        
        '添加形状指令AddShape (Type-msoShapeRectangle实心矩形、Left左上角相对于文档左侧的位置、Top顶部坐标、 Width矩形宽度、 Height矩形高度)
        
 '此处省略部分核心程序，需要请到我的资源下载源文件
        
        '绘制趋势线
        If Cells(I, 17) <> "" Then
            Fy1 = Y0 - Cells(I, 17) * k
            If rFy1 > 0 Then ActiveSheet.Shapes.AddLine rFx1, rFy1, Lx, Fy1 '
            rFx1 = Lx
            rFy1 = Fy1
        End If
        
        If Cells(I, 18) <> "" Then '分型顶
            Fy1 = Y0 - Cells(I, 18) * k
            If rFy1 > 0 Then ActiveSheet.Shapes.AddLine rFx1, rFy1, Lx, Fy1   '
            rFx1 = Lx
            rFy1 = Fy1
        End If
        
    Next
End Sub

3.清除excel中除按钮外的所有图形

代码如下：

    '清除原有K线图形
    For Each S In ActiveSheet.Shapes
        If S.Type <> 8 Then            '有插入一个窗体控件指定宏
            S.Delete                   '把不是窗体控件的shape（图片、图形等）清除
        End If
    Next S

4.绘制K线图

代码如下：

       '绘制K线
        ActiveSheet.Shapes.AddLine Lx, Y0 - Arr(I, 6) * k, Lx, Y0 - Arr(I, 5) * k    'AddLine (BeginX、 BeginY、 EndX、 EndY)，画一条从最低价Arr(I, 6)到最高价Arr(I, 5)的竖线
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, X0 + X1 - 1.5, Y0 - WorksheetFunction.Max(Arr(I, 4), _
            Arr(I, 7)) * k, 3, Abs(Arr(I, 4) - Arr(I, 7)) * k).Select                '画一条从开盘价到收盘价的柱状线，并选中
        
        '添加形状指令AddShape (Type-msoShapeRectangle实心矩形、Left左上角相对于文档左侧的位置、Top顶部坐标、 Width矩形宽度、 Height矩形高度)
        
        With Selection.ShapeRange                           '为K线设置颜色
            If Arr(I, 4) - Arr(I, 7) >= 0 Then              '对于选中的矩形，当收盘价≥开盘价时，矩形为红色，否则为绿色
                .Fill.ForeColor.SchemeColor = 10
                .Line.DashStyle = msoLineSolid              '设置矩形的边线形式为长直线
                .Line.ForeColor.SchemeColor = 10
            Else
                .Fill.ForeColor.SchemeColor = 11
                .Line.DashStyle = msoLineSolid
                .Line.ForeColor.SchemeColor = 11
            End If
        End With

总结

绘制K线图和趋势线是一个非常复杂的功能，程序也比较复杂，其中涉及很多算法的部分，这里就不一一讲解了，喜欢的话可以自己看注释。

weitingfu
关注
  • 3
    点赞
  • 踩
  • 14
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
专栏目录
通过VBA在excel中画处股票的K线图和波段趋势线
10-12
excel有很多强大的易用功能，尝试与股票分析直观的结合起来。刚刚开始学，请大家多多批评指正，我一步一步慢慢来。
通过VBA在excel中实现股票当日走势数据查询表.docx
10-08
通过VBA在excel中实现股票当日走势数据查询表
Excel+VBA+获取股票的历史数据+股票+基金+投资+理财+源代码+可直接使用
01-30
如标题
量化经济学：手把手教你如何使用EXCEL分析股票历史数据
weixin_43996337的博客
04-14 7918
1.数据来源获取 数据集的下载来源为Yahoo Finance。Yahoo Finance是雅虎公司金融媒体领域的一个相关网站。它提供财经新闻、数据和评论，包括股票报价、新闻稿、财务报告和原创内容。它还提供了一些用于个人财务管理的在线工具。除了发布来自其他网站的合作伙伴内容外，它还发布其员工记者团队的原创故事。在最大的新闻和媒体网站列表中，它被 SimilarWeb 排名第 21 位。其上能便捷的查阅各大公司的历史股价变化数据，兼具权威性与方便性，因此我们将其作为我们数据获取的来源。网站的具体使用如下图所
Excel——如何利用excel的功能爬取网页表格类型的数据以及自动更新
最新发布
龙皮皮的博客
02-23 1332
珞珈AI办公。
用Excel实时看股票数据--vba（无需安装任何软件）
热门推荐
wayright的专栏
08-03 2万+
（7）补充：网友回复无法区分sz和sh，这里把GetData函数修改了一下，让第一列可以输入纯数字或者带字母的输入，比如sz000001。（3）选择ThisWorkbook选项，添加Workbook的Open函数，这样在excel打开的时候就会自动执行GetData。（5）点击选项，可以设置快捷命令，例如Ctrl+R，用快捷键刷新看实时数据。提取其中的名称（民生银行），收盘价格，昨日价格，涨跌百分比即可。（6）Excel保存为可以运行宏的文件，如stock.xlsm。
基金+历史数据+VBA+Excel+获取基金历史数据+VBA源代码+可直接使用
01-30
如标题
用vb.net实现的可以实现股票指数实时监控,并且统计某个时间段的涨跌幅度
06-13
用vb.net实现的可以实现股票指数实时监控,并且统计某个时间段的涨跌幅度
干货全拿走-用Excel获取上证指数等50+股指行情及历史数据
m0_64899365的博客
09-18 3929
用Excel VBA获取上证指数等股指行情及历史数据
用Excel实现自动获取期货、期权、股票行情及下载历史数据
m0_64899365的博客
09-18 6940
用ExcelVBA获取期货及股票数据等
用ExcelVBA下载股票板块历史数据
m0_64899365的博客
01-29 1667
利用VBA爬取股票板块历史数据
【vba】使用Excel来根据股票代码获取股票名称
scochi的博客
02-06 922
使用vba自定义函数，根据股票代码获取股票名称
股票历史数据和K线图趋势线的绘制
08-21
虽然现在各种股票APP都可以轻松查看股票K线图，但是自动生成趋势图却常常需要收费，因此考虑自己用excel做一个股票K线和趋势图的表格，可以通过股票代码和简单的设置，生成股票K线图和趋势图。 一、目标 1、根据股票代码查询历史数据； 2、根据历史数据绘制K线图和高低点趋势图。 二、方法 1、通过VBA程序，从网络上获取股票的历史数据； 2、通过VBA程序，选取需要的天数的数据，绘制K线图和趋势线。 ———————————————— 版权声明：本文为CSDN博主「weitingfu」的原创文章，遵循CC 4.0 BY-SA版权协议，转载请附上原文出处链接及本声明。 原文链接：https://blog.csdn.net/weitingfu/article/details/126452537
用ExcelVBA下载股票龙虎榜历史数据
m0_64899365的博客
01-29 510
利用VBA抓取股票龙虎榜数据
EXCEL自动抓取每天股票信息源码 Excel爬虫股票信息源码 在线股票操盘手源码 VBA实时自动抓取每天股票信息源码 VBA实时爬虫股票信息源码
oSenLin123456的博客
07-04 655
Excel提供了多种方式获取数据，包括数据连接、VBA编程等，可以方便地从股票数据接口中获取实时的股票行情。实时性高：通过访问股票数据接口，可以实时获取到股票的实时行情数据，包括当前股价、涨跌幅、成交量、市盈率等信息，保证了股票数据的实时性。数据准确性高：由于股票数据接口的数据来源通常是官方数据源或金融机构，因此股票数据的准确性和可信度相对较高，可以满足各种应用场景的需求。方便快捷：通过股票数据接口获取数据非常方便快捷，只需要访问相应的API接口，并解析返回的数据即可，无需进行复杂的数据采集和处理。
股票历史数据-股票历史交易数据下载成Excel，股票历史交易数据查询
股票历史数据_查询、下载股票历史数据
06-21 1601
共享一个股票历史交易数据下载的工具，可以在线下载股票历史交易数据，股票历史交易数据下载的是：股票从成立到最近一天的所有股票历史交易数据，亲测手机在线就能下载股票历史交易数据，A股、港股、美股所有个股的股票历史交易数据都能下载
获取所有股票历史数据存到Excel-02
weixin_44649197的博客
01-19 1213
www.baostock.com​ www.baostock.com 可以看下baostock接口，官网上有示例代码，比如下载单只股票的数据，代码如下。需要全部的股票数据，可以结合“证券代码查询”：query_all_stock()，对查询出的代码进行遍历就可以了，希望能够帮到你。 import baostock as bs import pandas as pd #### 登陆系统 #### lg = bs.login() # 显示登陆返回信息 print('login respond error_
以股票历史数据抓取为例，浅谈踩过的VBA网抓的“坑”
m0_64899365的博客
09-18 1571
用Excel VBA网抓的经验分享
我想在excel中实现数据拆分和行的转换，帮我写一段脚本在excel中实现他
09-18
### 回答1： 在Excel中实现数据拆分和行的转换，可以使用VBA脚本来实现，具体实现步骤如下：1.打开Excel文件，在工具栏中点击“开发工具”；2.在弹出的VBA编辑器中，点击“插入”，然后点击“模块”；3.在模块窗口中编写代码，实现数据拆分和行的转换；4.完成代码编写后，点击“调试”，然后点击“运行”，即可实现数据拆分和行的转换。 ### 回答2： 要在Excel中实现数据拆分和行的转换，可以使用Excel的宏功能来编写脚本。以下是我为您编写的Excel VBA脚本： ```vba Sub 数据拆分和行转换() Dim 原始表 As Worksheet Dim 结果表 As Worksheet Dim 原始表最后行 As Long Dim 结果表当前行 As Long ' 设置原始表和结果表对象 Set 原始表 = Worksheets("原始数据") Set 结果表 = Worksheets("结果数据") ' 获取原始表最后一行的行号 原始表最后行 = 原始表.Cells(Rows.Count, 1).End(xlUp).Row ' 清空结果表中的数据 结果表.Cells.Clear ' 设置结果表表头 结果表.Range("A1:F1") = Array("姓名", "性别", "年龄", "地址", "邮编", "电话") ' 设置结果表当前行从第2行开始 结果表当前行 = 2 ' 循环处理原始表数据 For i = 2 To 原始表最后行 ' 获取原始表中的数据 姓名 = 原始表.Cells(i, 1) 性别 = 原始表.Cells(i, 2) 年龄 = 原始表.Cells(i, 3) 地址 = 原始表.Cells(i, 4) 邮编 = 原始表.Cells(i, 5) 电话 = 原始表.Cells(i, 6) ' 拆分地址字段 地址数组 = Split(地址, " / ") ' 获取地址数组的长度 地址数组长度 = UBound(地址数组) - LBound(地址数组) + 1 ' 循环向结果表插入拆分后的数据 For j = LBound(地址数组) To UBound(地址数组) 结果表.Cells(结果表当前行, 1) = 姓名 结果表.Cells(结果表当前行, 2) = 性别 结果表.Cells(结果表当前行, 3) = 年龄 结果表.Cells(结果表当前行, 4) = 地址数组(j) 结果表.Cells(结果表当前行, 5) = 邮编 结果表.Cells(结果表当前行, 6) = 电话 ' 结果表当前行向下移动一行 结果表当前行 = 结果表当前行 + 1 Next j Next i ' 自动调整结果表中的列宽 结果表.Columns.AutoFit End Sub ``` 您只需按照以下步骤使用此脚本： 1. 打开Excel文件，按下Alt+F11打开VBA编辑器。 2. 在左侧的“项目资源管理器”窗口中，双击“这台电脑”并展开工作簿、模块目录。 3. 在模块目录中，右键单击一个空白区域，选择“插入”->“模块”。 4. 将上述脚本复制粘贴到新模块中。 5. 关闭VBA编辑器。 6. 在Excel中，按下Alt+F8打开宏对话框。 7. 选择“数据拆分和行转换”宏，并点击“运行”。 这样，您就能在Excel中实现数据拆分和行的转换了。注意，需要将原始数据表和结果数据表命名为"原始数据"和"结果数据"。如有需要，请根据实际情况进行脚本的修改。 ### 回答3： 在Excel中实现数据拆分和行转换可以使用宏来实现。以下是一个示例脚本，用于将列A中的数据按照指定的分隔符拆分成多列，并将每个拆分后的数据转换为一行。 首先，按下Alt + F11打开Visual Basic编辑器。在模块中插入如下脚本： ``` Sub 拆分与转换() Dim cell As Range Dim splitArr As Variant Dim lastRow As Long Dim newRowIndex As Long lastRow = Range("A" & Rows.Count).End(xlUp).Row newRowIndex = 2 For Each cell In Range("A2:A" & lastRow) '从A2开始遍历到最后一行 splitArr = Split(CStr(cell.Value), "/") '根据需求的分隔符进行拆分 For i = LBound(splitArr) To UBound(splitArr) Cells(newRowIndex, i + 2).Value = splitArr(i) '在新行的相应列填入拆分后的数据 Next i cell.ClearContents '清除原始数据 newRowIndex = newRowIndex + 1 '行指针向下移动 Next cell End Sub ``` 在Excel的工作表中，选择需要拆分的数据所在的列，并按下Alt + F8，然后选择“拆分与转换”宏并点击“运行”按钮。 注意，以上脚本默认假设拆分后的数据将放入原数据的右侧相邻列中，若有特殊要求，可以相应调整脚本中的行列索引。 希望能够帮到您！

“相关推荐”对你有帮助么？

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值