[分享]股票行情自动更新

hnlcn · 发表于 2009-9-3 20:47

原帖由 itxianfeng 于 2009-8-13 21:51 发表
楼主的代码我用了大概两个月了，感觉是EXCEL里面最好的，最实用的，因为它可以根据用户的需要来搜索数据。
但是这个代码有个毛病只能运行150个代码，多了就会罢工，不过我把它修改过来，一次可以运行上千多条股票， ...

求了！能否将您的成果分享一下。或者将修改后，可以运行上千多条股票代码的方法告知。先谢谢了！我邮箱 hnlcn@163.com 谢谢

itxianfeng · 发表于 2009-9-3 21:14

Sub refresh()

Dim x As Long

Dim result, tmp
Dim str1 As String

x = Range("D2").Value
' Sheets(1).Cells(2, 4) = 0  '将显示正在运行的行数归零

str1 = ""

idx = x '确定  显示的第一行的行次

While Sheets(1).Cells(idx, 1) <> "" '如果股票代码行不为空就将股票代码传递给变量str1
      str1 = str1 & Sheets(1).Cells(idx, 1).Value & ","
      idx = idx + 1                   '如果股票代码行不为空就将将行次向下移动一行
Wend
result = Jrj0DayData(str1)
DoEvents

For idx = 0 To UBound(result)
      tmp = Split(result(idx), ",")
      Select Case UBound(tmp)
      Case 31:                   '源数据是每页31行
                  Select Case (tmp(3) - tmp(2))    '根据收盘价与最新价的差来分别执行下面的任务
                  Case Is > 0:
                  '如果新价格大于昨天的收盘价，那么就将该该行的C列：F列的字体颜色设置为红色，单元格内容显示为向上的箭头
                     Sheets(1).Range("C" & idx + x & ":F" & idx + x).Font.ColorIndex = 3
                     Sheets(1).Cells(idx + x, 3) = "↑"
                  Case 0:
                  '如果新价格等于昨天的收盘价，那么就将该该行的C列：F列的字体颜色设置为白色，单元格内容显示为一个线段
                     Sheets(1).Range("C" & idx + x & ":F" & idx + x).Font.ColorIndex = 1
                     Sheets(1).Cells(idx + x, 3) = "-"
                  Case Is < 0:
                  '如果新价格小于于昨天的收盘价，那么就将该该行的C列：F列的字体颜色设置为绿色，单元格内容显示为向下的箭头
                     Sheets(1).Range("C" & idx + x & ":F" & idx + x).Font.ColorIndex = 4
                     Sheets(1).Cells(idx + x, 3) = "↓"
                  End Select
            Sheets(1).Cells(idx + x, 2) = tmp(0)    '股票名称
            If tmp(3) = 0 Then                         '如果股票代码为空就在下面的行中执行输入“-”
                  Sheets(1).Cells(idx + x, 3) = "-"
                  Sheets(1).Cells(idx + x, 4) = "-"    '最新价
                  Sheets(1).Cells(idx + x, 5) = "-"    '(最新价-昨收)/昨收
                  Sheets(1).Cells(idx + x, 6) = "-"    '最新价-昨收
                  Sheets(1).Cells(idx + x, 17) = "-" '涨幅走势
                  'Sheets(1).Cells(idx + 99, 7) = "-" '最高
                  'Sheets(1).Cells(idx + 99, 8) = "-" '最低价
                  ' Sheets(1).Cells(idx + 99, 9) = "-" '
                  ' Sheets(1).Cells(idx + 99, 10) = "-" '
                  'Sheets(1).Cells(2, 6) = idx + x  '显示正在运行的行数

            Else                                     '如果股票代码不为空就在下面的行中执行输入数据
                  Sheets(1).Cells(idx + x, 5) = tmp(3)    '最新价
                  Sheets(1).Cells(idx + x, 4) = (tmp(3) - tmp(2)) / tmp(2) '(最新价-昨收)/昨收=涨跌幅

         '    Sheets(1).Cells(idx + x, 17) = (tmp(3) - tmp(2)) / tmp(2) - Sheets(1).Cells(idx + x, 17)  '涨幅走势

                  Sheets(1).Cells(idx + x, 6) = tmp(3) - tmp(2) '最新价-昨收=涨跌额
               ' Sheets(1).Cells(idx + 99, 7) = tmp(4)    '最高价
               ' Sheets(1).Cells(idx + 99, 8) = tmp(5)    '最低价
                  'Sheets(1).Cells(idx + 99, 9) = tmp(15) '换手率
                  'Sheets(1).Cells(idx + 99, 10) = tmp(24) '量比

               Sheets(1).Cells(idx + x, 14) = tmp(8) / 100 '成交（手）





            End If

            Sheets(1).Cells(idx + x, 16) = tmp(31)       '时间
                        Sheets(1).Cells(2, 6) = idx + x '显示正在运行的行数
      Case 18:          '源数据是每页18行
            Sheets(1).Cells(idx + x, 2) = tmp(1)       '股票名称
            Sheets(1).Cells(idx + x, 4) = (tmp(6) - tmp(2)) / tmp(2) '(最新价-昨收)/昨收
            Sheets(1).Cells(idx + x, 17) = (tmp(6) - tmp(2)) / tmp(2) - Sheets(1).Cells(idx + x, 17)  '涨幅走势

            Sheets(1).Cells(idx + x, 5) = tmp(6)       '最新价
            Sheets(1).Cells(idx + x, 6) = tmp(6) - tmp(2) '最新价-昨收=涨跌额

            ' Sheets(1).Cells(idx + 99, 7) = tmp(4)       '最高价
            ' Sheets(1).Cells(idx + 99, 8) = tmp(5)       '最低价
            ' Sheets(1).Cells(idx + 99, 9) = tmp(15)       '换手率
            ' Sheets(1).Cells(idx + 99, 10) = tmp(24)    '量比
            Sheets(1).Cells(idx + x, 14) = tmp(8) / 100 '成交（手）

            Sheets(1).Cells(idx + x, 16) = tmp(18)    '时间
               Sheets(1).Cells(2, 6) = idx + x '显示正在运行的行数
                  Select Case (tmp(6) - tmp(2))
                  Case Is > 0:
                     Sheets(1).Range("C" & idx + x & ":F" & idx + x).Font.ColorIndex = 3
                     Sheets(1).Cells(idx + x, 3) = "↑"
                  Case 0:
                     Sheets(1).Range("C" & idx + x & ":F" & idx + x).Font.ColorIndex = 1
                     Sheets(1).Cells(idx + x, 3) = "-"
                  Case Is < 0:
                     Sheets(1).Range("C" & idx + x & ":F" & idx + x).Font.ColorIndex = 4
                     Sheets(1).Cells(idx + x, 3) = "↓"
                  End Select
                     Sheets(1).Cells(2, 6) = idx + x '显示正在运行的行数
      End Select
Next
' DoEvents

' Application.OnTime Now + TimeSerial(0, 0, 5), "refresh"

' DoEvents

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
' If Target.Count > 1 Then Exit Sub
' If (Target.Column = 3 Or Target.Column = 4) And Target.Row > 1 Then MsgBox ("ok")
End Sub

Sub 控制程序()

s = Range("h2").Value
s = s + 1
Range("h2").Value = s

Range("D2").Value = "199"       '99至324  325空
refresh
Range("D2").Value = "355" ' 99+157=256  257+67=324
refresh
Range("D2").Value = "426"       '326至551  552空
refresh
Range("D2").Value = "582" ' 326+157=483 484+67=551
refresh
Range("D2").Value = "653"       '553至778  779空
refresh
Range("D2").Value = "809" ' 553+157=710 711+67=778
refresh
Range("D2").Value = "880"       '780至1003 1004空
refresh
Range("D2").Value = "1036" ' 780+157=937 938+67=1003
refresh
Range("D2").Value = "1107"    '1005至1230  1231空
refresh
Range("D2").Value = "1263" ' 1005+157=1162 1163+67=1230
refresh
Range("D2").Value = "1332" ' 1005+157=1162 1163+67=1230
refresh
Range("D2").Value = "1486"    '1005至1230  1231空
refresh
Range("D2").Value = "1553" ' 1005+157=1162 1163+67=1230
refresh
Range("D2").Value = "1710" ' 1005+157=1162 1163+67=1230
refresh
'Range("D2").Value = "1882" ' 1005+157=1162 1163+67=1230
'refresh

' Application.OnTime Now + TimeSerial(0, 0, 5), "控制程序" '每隔5分钟重新运行一次

End Sub

itxianfeng · 发表于 2009-9-3 21:26

因为我的工作簿表有工作单位的关联性数据，不便提供，所以只提供代码
操作步骤如下
先将上述代码粘贴到到原先的代码框中
再鼠标右键将按钮的代码指定成“控制程序”，
为了留出分析专用的行，我已经将表改成从第199行开始输入代码，请从第199行开始输入数据，注意第425行 652行 879行 1106行必须整行是空的，否则程序无法正常运行（这个原因现在我也没有搞清楚，程序运行150行就罢工的原因就在于此，可能只有楼主知道其明理，我费了很多的时间才把这个程序调好，就是把停下的地方，重新用控制程序将其强制继续运行下去）

[ 本帖最后由 itxianfeng 于 2009-9-3 21:33 编辑 ]

hnlcn · 发表于 2009-9-4 17:07

原帖由 itxianfeng 于 2009-9-3 21:26 发表
因为我的工作簿表有工作单位的关联性数据，不便提供，所以只提供代码
操作步骤如下
先将上述代码粘贴到到原先的代码框中
再鼠标右键将按钮的代码指定成“控制程序”，
为了留出分析专用的行，我已经将表改成从第 ...

非常感谢您的帮助。很感动，好人一生平安，万事顺心如意！
不知是因为自己笨还是怎的，还是不能用。提示：“编译错误”___“子过程或函数未定义”

[ 本帖最后由 hnlcn 于 2009-9-4 17:31 编辑 ]

itxianfeng · 发表于 2009-9-4 21:27

看看我的附件，自己往里输入股票代码吧，格式照葫芦画瓢，目前已经修改到最多可以达到1600行
千万注意我要求空行的地方，必须是空行，程序才能正常运行

[ 本帖最后由 itxianfeng 于 2009-9-4 21:32 编辑 ]

hnlcn · 发表于 2009-9-5 15:22

原帖由 itxianfeng 于 2009-9-4 21:27 发表
看看我的附件，自己往里输入股票代码吧，格式照葫芦画瓢，目前已经修改到最多可以达到1600行
千万注意我要求空行的地方，必须是空行，程序才能正常运行

您好！非常感谢您的帮助。很感动也很感谢。您传上来的东西已经收悉。只是那个太复杂。想留待以后慢慢研究使用。我还想求您帮个忙。我已将那个最初的可更新附件下来发上传。能否麻烦您帮助修改成可以添加1000条左右的代码就行。其他不用动。然后您上传到这里或者发我邮箱（我邮箱:hnlcn@163.com）都可以。您看行吗！真不好意思。给您添太多麻烦了！

itxianfeng · 发表于 2009-9-5 15:32

因为原始代码不是我编写的，特别是网页浏览这块程序，我是最头晕的，我当时找到那些必须空的行找得很是麻烦，也很费时间，是我一行一行的找到断点再接头再调试出来的，所以修改起来很麻烦。
其实我在57楼的表格和你的附件一模一样，什么也没有改，只是起始行不同，你的是第3行，我的是199行，你将数据从199行开始放入就可以正常运行。但是57楼对空行的要求必须记住
如果第3行-197行不用，你可以将这些行隐藏啊。

[ 本帖最后由 itxianfeng 于 2009-9-5 15:44 编辑 ]

itxianfeng · 发表于 2009-9-5 16:01

刚才看到楼上的表里面有港股的数据，中国深沪股票可能和港股肯定不是一个网页的，不过港股数据从我没有使用过，不知道我改写的程序能否调出港股的数据。因为我改变了这个程序的部分结构。

[ 本帖最后由 itxianfeng 于 2009-9-5 16:03 编辑 ]

itxianfeng · 发表于 2009-9-5 16:11

非常高兴，刚才回答60楼的问题的时候，我悟出了一个始终不明白的问题，就是源代码中为什么网页页数不同的问题，
楼主对网页页数分别编写了两个程序，原因就是中国深沪的股票页数和香港的股票页数是不相同显示的。

[ 本帖最后由 itxianfeng 于 2009-9-5 16:12 编辑 ]

hnlcn · 发表于 2009-9-5 16:43

原帖由 itxianfeng 于 2009-9-5 15:32 发表
因为原始代码不是我编写的，特别是网页浏览这块程序，我是最头晕的，我当时找到那些必须空的行找得很是麻烦，也很费时间，是我一行一行的找到断点再接头再调试出来的，所以修改起来很麻烦。
其实我在57楼的表格和你 ...

您好！感谢您的及时指导。您能告知您的电话吗！可以电话向您咨询吗(电话可以发我邮箱：hnlcn@163.com)。根据您的指导，刚找到点小道道。不过觉得自己欠缺的还比较多。想多向您请教请教！谢谢。另外我想在您提供的系统里出现：涨跌幅、最新价、涨跌额、最高、最低价、成交量(手)、成交额(万) 、换手率、昨收、今开盘、时间这几项可以吗，能否指教。或发附件。谢谢。麻烦您这么多确实有点不好意思！

[ 本帖最后由 hnlcn 于 2009-9-5 17:01 编辑 ]

		自动登录	找回密码
密码			免费注册