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

weitingfu

已于 2022-08-31 08:16:48 修改

阅读量4.6k

点赞数 3

于 2022-08-21 17:16:27 首次发布

本文链接：https://blog.csdn.net/weitingfu/article/details/126452537

版权

自动化办公专栏收录该内容

9 篇文章 12 订阅

订阅专栏

原始文件下载地址：股票历史数据和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
点赞
踩
15

收藏

觉得还不错? 一键收藏
0
评论
通过VBA在excel中实现股票历史数据查询和K线趋势图绘制（完整的excel原件可以在我的资源中下载）

虽然现在各种股票APP都可以轻松查看股票K线图，但是自动生成趋势图却常常需要收费，因此考虑自己用excel做一个股票K线和趋势图的表格，可以通过股票代码和简单的设置，生成股票K线图和趋势图。绘制K线图和趋势线是一个非常复杂的功能，程序也比较复杂，其中涉及很多算法的部分，这里就不一一讲解了，喜欢的话可以自己看注释。......
复制链接

扫一扫