标题：持仓信息导出Excel并管理盈亏的代码，精华呀！

1楼

guotx2010 发表于：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编辑过]

2楼

guotx2010 发表于：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
'未完，待续

3楼

guotx2010 发表于：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

4楼

rogerhylt 发表于：2011/10/22 11:51:59

精华这个牛

5楼

sun884588 发表于：2012/5/26 6:43:04

很强大，很强大

6楼

guotx2010 发表于：2012/5/26 8:40:20

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

7楼

sun884588 发表于：2012/6/5 17:10:12

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

8楼

爬山虎福气 发表于：2017/11/15 21:41:36

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

共8 条记录, 每页显示 10 条, 页签: [1]