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


金字塔客服中心 - 专业程序化交易软件提供商 → 金字塔软件 → 高级功能研发区 → 持仓信息导出Excel并管理盈亏的代码，精华呀！

   

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

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

主题：持仓信息导出Excel并管理盈亏的代码，精华呀！
帅哥哟，离线，有人找我吗？
guotx2010
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：蜘蛛侠 帖子：1366 积分：5210 威望：0 精华：7 注册：2010/12/11 18:00:33 		持仓信息导出Excel并管理盈亏的代码，精华呀！  发帖心情 Post By：2011/6/8 16:04:22 [只看该作者]

这个模块需要打开Excel文件holdhing.xlsx，请下载:

http://m1.mail.sina.com.cn/apps/netdisk/download.php?id=53749010fa1386e8191cbf6f39c9b367

 

安装说明：

1、在d:\下建立一个目录GuZhi

2、将Holding.xlsx复制到D:\Guzhi下

3、建立一个VBA模块，将下面的代码复制进去，保存。

4、运行了VBA之后，在工具菜单上的扩展项下有两个选择：1）启动持仓管理 2）终止持仓管理，要进行管理就选择1），不要管理就选择2）。

5、Excel文件中有一个模式：可选择：管理盈亏、显示盈亏，选择“显示盈亏”时，只实时显示持仓的盈亏情况，并不帮你平仓，选择“管理盈亏”时，将根据你的设置进行盈亏管理，如果你有一个品种不想进行管理，可以将止损点数、止盈点数、回撤点数、保本点数都设为0（0值不显示），如果不想使用移动止盈，可以单修改回撤点数为0，其他如此类推。

 

如果你想下载完整的东西，可以单击：

http://m1.mail.sina.com.cn/apps/netdisk/download.php?id=9750c4bbbd07723ef3f1cb815c140482

就不用自己建立模块了，但是1、2步还是得做的。第3步只要将这个压缩文件中的mdHold.bas导入到VBA模块中就行了。

 

 

 

 

[此贴子已经被作者于2011-6-8 16:13:32编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
guotx2010
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：蜘蛛侠 帖子：1366 积分：5210 威望：0 精华：7 注册：2010/12/11 18:00:33 		  发帖心情 Post By：2011/6/8 16:06:09 [只看该作者]

public objExcel,objWorkbook
public AccountCode,Code,Market
private CodeArr(6),MarketArr(6),HoldingCount
private Report(6)
private iRow,iTimeCount
private Multipliter,MinTick,ShortPercent,LongPercent

 ''''''''''菜单操作
Sub MENU_Show()
 Menu.AddMenu 0, 0, "启动持仓管理"
 Menu.AddMenu 1, 1, "终止持仓管理"
End Sub
 
Sub MENU_Command(Cmd)
 Select Case Cmd
 Case 0
  StartManage
 Case 1
  EndManage
 End Select
End Sub


Sub APPLICATION_VBAStart()
 iTimeCount=0
 iRow=4
 GetAccountCode      '将当前登录的账号保存到变量
End Sub

Sub APPLICATION_Timer(ID)
 iTimeCount=iTimeCount+1
 GetAccountCode
 On error Resume Next
 WriteNewPrice
 application.PeekAndPump
End Sub

Sub StartManage()  '启动
 GetAccountCode      '将当前登录的账号保存到变量
 iRow=4
 OpenExcel
 Call Application.SetTimer(5,2000)
 GetAllHolding AccountCode
End Sub 

Sub EndManage   '停止管理
 Application.KillTimer(5)
 Set objExcel=Nothing
End Sub

Sub WriteNewPrice()
 dim i,iHold,NewPrice
 
 i=4
 On error resume next
 objExcel.sheets(1).Range("TimeCount").Value = iTimeCount
 
 Do while objExcel.sheets(1).Cells(i,2).Value<>""
  Code=objExcel.sheets(1).Cells(i,2).Value
  Market=objExcel.sheets(1).Cells(i,23).Value
  
  Set Report1 = marketdata.GetReportData(Code,Market)
  NewPrice=Report1.NewPrice
  objExcel.sheets(1).Cells(i,19).Value = NewPrice
  If NewPrice>objExcel.sheets(1).Cells(i,20).Value then
   objExcel.sheets(1).Cells(i,20).Value=NewPrice
  End if
  If NewPrice<objExcel.sheets(1).Cells(i,21).Value then
   objExcel.sheets(1).Cells(i,21).Value=NewPrice
  End if
  
  'application.MsgOut objExcel.sheets(1).Cells(i,2).Value
  iHold=Abs(objExcel.sheets(1).Cells(i,3).Value)  '持仓手数
  
  If objExcel.sheets(1).Range("Mode").Value="管理盈亏" then
   '多单
   If objExcel.sheets(1).Cells(i,3).Value>0 then
    If NewPrice<objExcel.sheets(1).Cells(i,10).Value And objExcel.sheets(1).Cells(i,9).Value>0 then
     '止损
     WriteLog "买",NewPrice,"多单止损",i
     PingDuoDan 0,Code,Market,iHold
    End if
    If NewPrice>objExcel.sheets(1).Cells(i,12).Value And objExcel.sheets(1).Cells(i,11).Value>0 then
     '止赢
     WriteLog "买",NewPrice,"多单止盈",i
     PingDuoDan 0,Code,Market,iHold
    End if
    If objExcel.sheets(1).Cells(i,13).Value>0 And NewPrice>objExcel.sheets(1).Cells(i,5).Value then '回撤止赢
     If objExcel.sheets(1).Cells(i,20).Value-NewPrice>objExcel.sheets(1).Cells(i,13).Value then '回撤点数大于设置数
      WriteLog "买",NewPrice,"多单回撤止盈",i
      PingDuoDan 0,Code,Market,iHold
     End if
    End if 
    If NewPrice<objExcel.sheets(1).Cells(i,16).Value And NewPrice>objExcel.sheets(1).Cells(i,5).Value _
    And objExcel.sheets(1).Cells(i,20).Value>objExcel.sheets(1).Cells(i,5).Value+2 And objExcel.sheets(1).Cells(i,15).Value>0 then
     '保本:最高价大于保本价，最新价小于保本价，且有盈利
     WriteLog "买",NewPrice,"多单保本",i
     PingDuoDan 0,Code,Market,iHold
    End if
   End if 'End 多单
   '空单
   If objExcel.sheets(1).Cells(i,3).Value<0 then
    If NewPrice>objExcel.sheets(1).Cells(i,10).Value And objExcel.sheets(1).Cells(i,9).Value>0 then
     '止损
     WriteLog "卖",NewPrice,"空单止损",i
     PingKongDan 0,Code,Market,iHold
    End if
    If NewPrice<objExcel.sheets(1).Cells(i,12).Value And objExcel.sheets(1).Cells(i,11).Value>0 then
     '止赢
     WriteLog "卖",NewPrice,"空单止盈",i
     PingKongDan 0,Code,Market,iHold
    End if
    If objExcel.sheets(1).Cells(i,13).Value>0 And NewPrice<objExcel.sheets(1).Cells(i,5).Value then '回撤止赢
     If NewPrice-objExcel.sheets(1).Cells(i,21).Value>objExcel.sheets(1).Cells(i,13).Value then '回撤点数大于设置数
      WriteLog "卖",NewPrice,"空单回撤止盈",i
      PingKongDan 0,Code,Market,iHold
     End if
    End if 
    
    If NewPrice<objExcel.sheets(1).Cells(i,5).Value-2 And NewPrice>objExcel.sheets(1).Cells(i,16).Value _
    And objExcel.sheets(1).Cells(i,20).Value>objExcel.sheets(1).Cells(i,16).Value And objExcel.sheets(1).Cells(i,15).Value>0 then
     '保本
     WriteLog "卖",NewPrice,"空单保本",i
     PingKongDan 0,Code,Market,iHold
    End if
   End if  'End 空单
  End if  'End 管理盈亏 
  i=i+1
 Loop 
End Sub

'写成交日志
Sub WriteLog(sAspect,nNewPrice,sMemo,iHoldRow)
 dim iLogRow  'sheets(2)已使用行数
 iLogRow=objExcel.sheets(2).UsedRange.Rows.Count+1
 objExcel.sheets(2).Cells(iLogRow,1).Value=CDate(Time)
 objExcel.sheets(2).Cells(iLogRow,2).Value=objExcel.sheets(1).Cells(iHoldRow,2).Value
 objExcel.sheets(2).Cells(iLogRow,3).Value=sAspect
 if sAspect="买" then
  objExcel.sheets(2).Cells(iLogRow,4).Value=objExcel.sheets(1).Cells(iHoldRow,3).Value
  objExcel.sheets(2).Cells(iLogRow,5).Value=objExcel.sheets(1).Cells(iHoldRow,5).Value
  objExcel.sheets(2).Cells(iLogRow,9).Value=(nNewPrice-objExcel.sheets(1).Cells(iHoldRow,5).Value)*objExcel.sheets(1).Cells(iHoldRow,22).Value*objExcel.sheets(1).Cells(iHoldRow,3).Value
 else
  objExcel.sheets(2).Cells(iLogRow,4).Value=Abs(objExcel.sheets(1).Cells(iHoldRow,3).Value)
  objExcel.sheets(2).Cells(iLogRow,5).Value=objExcel.sheets(1).Cells(iHoldRow,5).Value
  objExcel.sheets(2).Cells(iLogRow,9).Value=(objExcel.sheets(1).Cells(iHoldRow,5).Value-nNewPrice)*objExcel.sheets(1).Cells(iHoldRow,22).Value*Abs(objExcel.sheets(1).Cells(iHoldRow,3).Value)
 end if 
 '最高价、最低价
 objExcel.sheets(2).Cells(iLogRow,6).Value=objExcel.sheets(1).Cells(iHoldRow,20).Value
 objExcel.sheets(2).Cells(iLogRow,7).Value=objExcel.sheets(1).Cells(iHoldRow,21).Value
 objExcel.sheets(2).Cells(iLogRow,8).Value=nNewPrice
 objExcel.sheets(2).Cells(iLogRow,10).Value=sMemo
End Sub

Sub OpenExcel()
 On Error Resume Next
 Set objExcel = GetObject(,"Excel.Application")
 if Err.number<>0 then
  Set objExcel = CreateObject("Excel.Application")
  '打开指定文件
  Set objExcel = GetObject("D:\GuZhi\Holding.xlsx")
 else
  '打开指定文件
  Set objExcel = GetObject("D:\GuZhi\Holding.xlsx")
 end if 
 objExcel.Parent.Windows("Holding.xlsx").Activate
 objExcel.Application.DisplayFormulaBar=False
  objExcel.Application.Visible = True
End Sub
 
'成交后重新取得持仓信息
Sub Order_OrderStatusEx2(OrderID, Status, Filled, Remaining, Price, Code, Market, OrderType, Aspect, Kaiping, Account, AccountType)
 If Status="Filled" then
  GetAllHolding AccountCode
 End if 
End Sub
'未完，待续

 回到顶部
帅哥哟，离线，有人找我吗？
guotx2010
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：蜘蛛侠 帖子：1366 积分：5210 威望：0 精华：7 注册：2010/12/11 18:00:33 		  发帖心情 Post By：2011/6/8 16:06:57 [只看该作者]

'这里的代码接着上面的，放在上面模块下方。

 Sub GetAllHolding(sAccount)
  dim i,k
  dim BuyHolding
 dim BuyCost
 dim BuyTodayHolding
 dim SellHolding
 dim SellCost
 dim SellTodayHolding
 dim PNL
 dim UseMargin
 dim Code
 dim Market

  On Error resume Next
    objExcel.Sheets(1).Unprotect
   
  objExcel.Sheets(1).Range("Mode")="显示盈亏"
  
  objExcel.Sheets(1).Range("B4:E9").ClearContents
   
    objExcel.Sheets(1).Range("S4:U9").ClearContents
   
  objExcel.Sheets(1).Rows("4:9").Select
    objExcel.Application.Selection.EntireRow.Hidden = False
      
  HoldingCount=Order.Holding2(sAccount)
  'Application.MsgOut "HoldingCount:" & HoldingCount
  If HoldingCount>0 then
   For i=0 to HoldingCount-1
    Call Order.HoldingInfo2(i,BuyHolding,BuyCost,BuyTodayHolding,SellHolding,SellCost,SellTodayHolding,PNL,UseMargin,Code,Market,sAccount)
    CodeArr(i)=Code
    MarketArr(i)=Market
    GetContract Code,Market
    'Call Order.HoldingInfoByCode2(Code,Market,BuyHolding,BuyCost,BuyTodayHolding,SellHolding,SellCost,SellTodayHolding,PNL,UseMargin,sAccount)
    
    objExcel.sheets(1).Cells(i+iRow,2).Value = Code
    If BuyHolding>0 then
     objExcel.sheets(1).Cells(i+iRow,3).Value = BuyHolding
     objExcel.sheets(1).Cells(i+iRow,4).Value = BuyTodayHolding
     If BuyHolding>0 then
      objExcel.sheets(1).Cells(i+iRow,5).Value = BuyCost/Multipliter/BuyHolding
     Else
      objExcel.sheets(1).Cells(i+iRow,5).Value = BuyCost
     End if 
     If objExcel.sheets(1).Cells(i+iRow,20)=0 then  '如果最高价为0，将开仓价写入最高价
      objExcel.sheets(1).Cells(i+iRow,20)=objExcel.sheets(1).Cells(i+iRow,5)
      objExcel.sheets(1).Cells(i+iRow,21)=objExcel.sheets(1).Cells(i+iRow,5)
     End if 
    End if
 
    If SellHolding>0 then
     objExcel.sheets(1).Cells(i+iRow,3).Value = -SellHolding
     objExcel.sheets(1).Cells(i+iRow,4).Value = -SellTodayHolding
     If SellHolding>0 then
      objExcel.sheets(1).Cells(i+iRow,5).Value = SellCost/Multipliter/SellHolding
     Else
      objExcel.sheets(1).Cells(i+iRow,5).Value = SellCost
     End if 
     If objExcel.sheets(1).Cells(i+iRow,21)=0 then  '如果最低价为0，将开仓价写入最低价
      objExcel.sheets(1).Cells(i+iRow,21)=objExcel.sheets(1).Cells(i+iRow,5)
      objExcel.sheets(1).Cells(i+iRow,20)=objExcel.sheets(1).Cells(i+iRow,5)
     End if
    End if 
    objExcel.sheets(1).Cells(i+iRow,22).Value = Multipliter
    objExcel.sheets(1).Cells(i+iRow,23).Value = Market
   Next 'End i
   '设置数字微调按钮显隐
   For k=1 to HoldingCount
      objExcel.Sheets(1).Shapes("SpinZsds" & Cstr(k)).Visible = True
      objExcel.Sheets(1).Shapes("SpinZYds" & Cstr(k)).Visible = True
      objExcel.Sheets(1).Shapes("SpinYdZy" & Cstr(k)).Visible = True
      objExcel.Sheets(1).Shapes("SpinBbds" & Cstr(k)).Visible = True
      '设置微调按钮的位置
      objExcel.Sheets(1).Shapes("spinZsDs" & Cstr(k)).Top = objExcel.Sheets(1).Range("J" & Cstr(k+iRow-1)).Top
      objExcel.Sheets(1).Shapes("spinZsDs" & Cstr(k)).Left = objExcel.Sheets(1).Range("J" & Cstr(k+iRow-1)).Left - objExcel.Sheets(1).Shapes("spinZsDs" & Cstr(k)).Width
      objExcel.Sheets(1).Shapes("spinZsDs" & Cstr(k)).Height = objExcel.Sheets(1).Range("J" & Cstr(k+iRow-1)).Height
      
      objExcel.Sheets(1).Shapes("SpinZYds" & Cstr(k)).Top = objExcel.Sheets(1).Range("L" & Cstr(k+iRow-1)).Top
      objExcel.Sheets(1).Shapes("SpinZYds" & Cstr(k)).Left = objExcel.Sheets(1).Range("L" & Cstr(k+iRow-1)).Left - objExcel.Sheets(1).Shapes("SpinZYds" & Cstr(k)).Width
      objExcel.Sheets(1).Shapes("SpinZYds" & Cstr(k)).Height = objExcel.Sheets(1).Range("L" & Cstr(k+iRow-1)).Height
      
      objExcel.Sheets(1).Shapes("SpinYdZy" & Cstr(k)).Top = objExcel.Sheets(1).Range("N" & Cstr(k+iRow-1)).Top
      objExcel.Sheets(1).Shapes("SpinYdZy" & Cstr(k)).Left = objExcel.Sheets(1).Range("N" & Cstr(k+iRow-1)).Left - objExcel.Sheets(1).Shapes("SpinYdZy" & Cstr(k)).Width
      objExcel.Sheets(1).Shapes("SpinYdZy" & Cstr(k)).Height = objExcel.Sheets(1).Range("N" & Cstr(k+iRow-1)).Height
      
      objExcel.Sheets(1).Shapes("SpinBbds" & Cstr(k)).Top = objExcel.Sheets(1).Range("P" & Cstr(k+iRow-1)).Top
      objExcel.Sheets(1).Shapes("SpinBbds" & Cstr(k)).Left = objExcel.Sheets(1).Range("P" & Cstr(k+iRow-1)).Left - objExcel.Sheets(1).Shapes("SpinBbds" & Cstr(k)).Width
      objExcel.Sheets(1).Shapes("SpinBbds" & Cstr(k)).Height = objExcel.Sheets(1).Range("P" & Cstr(k+iRow-1)).Height
     Next
   If HoldingCount<6 then
      For k=HoldingCount+1 to 6
       objExcel.Sheets(1).Shapes("SpinZsds" & Cstr(k)).Visible = False
       objExcel.Sheets(1).Shapes("SpinZYds" & Cstr(k)).Visible = False
       objExcel.Sheets(1).Shapes("SpinYdZy" & Cstr(k)).Visible = False
       objExcel.Sheets(1).Shapes("SpinBbds" & Cstr(k)).Visible = False
      Next
      objExcel.Sheets(1).Rows(HoldingCount+iRow & ":9").Select
      objExcel.Application.Selection.EntireRow.Hidden = True
     End if
    Else
     objExcel.Sheets(1).Range("S4:U9").Select
     objExcel.Application.Selection.ClearContents
     objExcel.Rows("5:9").Select
     objExcel.Application.Selection.EntireRow.Hidden = True
  End if
  objExcel.Sheets(1).Range("B4").Select
  objExcel.ActiveSheet.Protect
End Sub

Sub GetContract(sCode,sMarket)  '获取合约的信息
 Call Order.Contract(sCode,sMarket,Multipliter,MinTick,ShortPercent,LongPercent)
End Sub

Sub GetAccountCode()        '取得当前登录的帐号
    Dim sAccount            '记录可能更换了的账号
    If AccountCode = "" Then
        AccountCode = CStr(Trim(ORDER.ACCOUNT(1)))
    End If
    sAccount = CStr(Trim(ORDER.ACCOUNT(1)))
    If sAccount = AccountCode Then
        Exit Sub
    Else
        AccountCode = sAccount
        GetAllHolding sAccount
    End If
End Sub

'平多单
Sub PingDuoDan(nPrice,sCode,sMarket,iOrdVol)  '平多单，nPrice=0时为市价，否则就是传递过来的价
 If iOrdVol>0 then
  If nPrice=0 then
   Call Order.Sell(1,iOrdVol,0,0,sCode,sMarket,"",0)    '市价平多单
  Else
   Call Order.Sell(0,iOrdVol,nPrice,0,sCode,sMarket,"",0)   '限价平多单
  End If 
 End If
End Sub
'平空单
Sub PingKongDan(nPrice,sCode,sMarket,iOrdVol)  '平空单，nPrice=0时为市价，否则就是传递过来的价
 If iOrdVol>0 then
  If nPrice=0 then
   Call Order.SellShort(1,iOrdVol,0,0,sCode,sMarket,"",0)    '市价平空单
  Else
   Call Order.SellShort(0,iOrdVol,nPrice,0,sCode,sMarket,"",0)   '限价平空单
  End If 
 End If
End Sub
 回到顶部
帅哥哟，离线，有人找我吗？
rogerhylt
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：新手上路 帖子：86 积分：572 威望：0 精华：0 注册：2010/4/5 17:26:37 		  发帖心情 Post By：2011/10/22 11:51:59 [只看该作者]

精华 这个牛

 回到顶部
帅哥哟，离线，有人找我吗？
sun884588
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：论坛游民 帖子：132 积分：775 威望：0 精华：0 注册：2011/12/27 11:53:44 		  发帖心情 Post By：2012/5/26 6:43:04 [只看该作者]

很强大，很强大

 回到顶部
帅哥哟，离线，有人找我吗？
guotx2010
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：蜘蛛侠 帖子：1366 积分：5210 威望：0 精华：7 注册：2010/12/11 18:00:33 		  发帖心情 Post By：2012/5/26 8:40:20 [只看该作者]

现在金字塔支持股票自动交易了，我这个持仓管理功能可以做些修改成为股票持仓管理的哟。

 
 回到顶部
帅哥哟，离线，有人找我吗？
sun884588
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：论坛游民 帖子：132 积分：775 威望：0 精华：0 注册：2011/12/27 11:53:44 		  发帖心情 Post By：2012/6/5 17:10:12 [只看该作者]

已经下载，还没用，慢慢学习，谢谢楼主

 回到顶部
帅哥哟，离线，有人找我吗？
爬山虎福气
 小大  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：标准版用户 帖子：56 积分：0 威望：0 精华：0 注册：2014/12/4 23:22:31 		  发帖心情 Post By：2017/11/15 21:41:36 [只看该作者]

看得头大，模仿写了一个，错误不断

 回到顶部
RSS2.0 | Xhtml无图版 | Xslt无图版    Powered By weistock 2012
页面执行时间 0.08594 秒, 5 次数据查询