欢迎使用金字塔普通技术服务论坛,您可以在相关区域发表技术支持贴。
我司技术服务人员将优先处理 VIP客服论坛 服务贴,普通区问题处理速度慢,请耐心等待。谢谢您对我们的支持与理解。


金字塔客服中心 - 专业程序化交易软件提供商金字塔软件高级功能研发区 → [求助]能把这个老代码改一下吗?

   

欢迎使用金字塔普通技术服务论坛,您可以在相关区域发表技术支持贴。
我司技术服务人员将优先处理 VIP客服论坛 服务贴,普通区问题处理速度慢,请耐心等待。谢谢您对我们的支持与理解。    


  共有3278人关注过本帖树形打印复制链接

主题:[求助]能把这个老代码改一下吗?

帅哥哟,离线,有人找我吗?
bbking
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:小飞侠 帖子:1609 积分:4924 威望:0 精华:0 注册:2010/10/28 14:02:46
[求助]能把这个老代码改一下吗?  发帖心情 Post By:2014/11/25 21:20:06 [只看该作者]

 

'窗体启动时初始化编辑框内容
Sub SearchMaincode_Load()
SearchMaincode_TextBoxType.Text = Document.GetPrivateProfileString("JZT","TextBoxType","概念","C:\JTZSetting.INI")
SearchMaincode_TextBoxBlock.Text = Document.GetPrivateProfileString("JZT","TextBoxBlock","主力合约","C:\JTZSetting.INI")
End Sub

Sub SearchMaincode_CommandButton1_Click()
SearchStart()
End Sub

'该函数查找主力合约
Sub SearchStart()

application.MsgOut Date &" " &Time& "检索主力合约"
Dim marketName
Set dominantContract=CreateObject("Scripting.Dictionary") '创建一个字典
marketName=Array("SQ","DQ","ZQ","ZJ","SY")
prefixStockNameOld=""
c"
contractVol=0

'找到的主力合约代码放这里
dim labels
dim markets

For j=0 To UBound(marketName)
n=marketData.GetReportCount(marketName(j))
For i=0 To n-1
Set reportData=marketdata.GetReportDataByIndex(marketName(j),i)
prefixStockNameCur=left(reportData.StockName,2)
suffixStockNameCur=right(reportData.StockName,2)
If suffixStockNameCur>="00" And suffixStockNameCur<"99" And reportData.Volume>0 Then
If prefixStockNameCur<>prefixStockNameOld Then
If contractLabel<>"" Then
dominantContract.Add contractMarket & contractLabel, 0
End If
prefixStockNameOld=prefixStockNameCur
contractLabel=reportData.Label
contractMarket=marketName(j)
contractVol=reportData.Volume
ElseIf reportData.Volume>contractVol then
contractLabel=reportData.Label
contractVol=reportData.Volume
End If

End If
Next
Next
dominantContract.Add contractMarket & contractLabel,0

labels=dominantContract.Keys
markets=dominantContract.Keys

FndCount = UBound(dominantContract.Keys)
Application.MsgOut "共找到"&FndCount&"个合约"

If FndCount > 0 Then
'整理一下数据,将市场和代码分开
For j=0 To FndCount
markets(j) = left(labels(j),2)
labels(j) = right(labels(j),len(labels(j))-2)
Next
SaveBlockAndOpen labels, markets
Else
MsgBox "没有找到主力合约"
End if

End Sub

'将找到的合约存于板块,并打开动态盘
Sub SaveBlockAndOpen(labels, markets)

Document.WritePrivateProfileString "JZT","TextBoxType",SearchMaincode_TextBoxType.Text,"C:\JTZSetting.INI"
Document.WritePrivateProfileString "JZT","TextBoxBlock",SearchMaincode_TextBoxBlock.Text,"C:\JTZSetting.INI"

'保存到板块
Set b = CreateObject("Stock.Block")
For j=0 To UBound(labels)
call b.AddStock(markets(j),labels(j))
Next
call b.toSave(SearchMaincode_TextBoxType.Text,SearchMaincode_TextBoxBlock.Text)

'打开动态显示牌
Application.ActivateFrame "Report"
Set Table = Report.GetGridByName("上海指数").GetTable()
Table.SwitchBlock SearchMaincode_TextBoxBlock.Text, 1
End Sub




SearchMaincode
用来搜索主力合约的
但是没有搜索夜盘品种好像
谁能补充一下?

 回到顶部
帅哥哟,离线,有人找我吗?
yukizzc
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:21598 积分:0 威望:0 精华:1 注册:2010/7/31 16:35:30
  发帖心情 Post By:2014/11/26 10:00:41 [只看该作者]

marketName=Array("SQ","DQ","ZQ","ZJ","SY")
你这里夜盘市场有了啊,本地这边运行后有夜盘品种的

 回到顶部
帅哥哟,离线,有人找我吗?
王锋
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:罗宾汉 帖子:11808 积分:20695 威望:0 精华:10 注册:2009/8/18 8:15:13
  发帖心情 Post By:2014/11/26 13:46:27 [只看该作者]

这个代码可能由于论坛限制,有些不全



金字塔—专业程序化软件提供商

金字塔-技术部

-----------------------------------------------------------------------------------------------------

工作时间:周一至周五 08:30 - 17:30   周末及法定节假日休息

Email:service@weistock.com
 回到顶部
帅哥哟,离线,有人找我吗?
bbking
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:小飞侠 帖子:1609 积分:4924 威望:0 精华:0 注册:2010/10/28 14:02:46
  发帖心情 Post By:2014/11/27 13:18:52 [只看该作者]

 老大~论坛里以前有搜索主力合约的VBA代码 的~现在出了夜盘了~

能否更新一下?

 回到顶部
帅哥哟,离线,有人找我吗?
bbking
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:小飞侠 帖子:1609 积分:4924 威望:0 精华:0 注册:2010/10/28 14:02:46
  发帖心情 Post By:2014/11/27 13:21:42 [只看该作者]

 你们这几个股票指数一放进来~这个vba一运行老是搜出来好多股票指数

 回到顶部
帅哥哟,离线,有人找我吗?
王锋
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:罗宾汉 帖子:11808 积分:20695 威望:0 精华:10 注册:2009/8/18 8:15:13
  发帖心情 Post By:2014/11/27 13:21:47 [只看该作者]

现在金字塔都自带这个功能了啊, 板块菜单上你都能看见



金字塔—专业程序化软件提供商

金字塔-技术部

-----------------------------------------------------------------------------------------------------

工作时间:周一至周五 08:30 - 17:30   周末及法定节假日休息

Email:service@weistock.com
 回到顶部
帅哥哟,离线,有人找我吗?
bbking
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:小飞侠 帖子:1609 积分:4924 威望:0 精华:0 注册:2010/10/28 14:02:46
  发帖心情 Post By:2014/11/27 13:42:39 [只看该作者]

才发现...

 
终于有个主力合约板块了



 回到顶部