持倉信息導出Excel并管理盈虧的代碼，精華呀！ [金字塔]
- 咨詢內容：
這個模塊需要打開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編輯過] - 金字塔客服：
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 SubSub APPLICATION_Timer(ID)
iTimeCount=iTimeCount+1
GetAccountCode
On error Resume Next
WriteNewPrice
application.PeekAndPump
End SubSub StartManage() '啟動
GetAccountCode '將當前登錄的賬號保存到變量
iRow=4
OpenExcel
Call Application.SetTimer(5,2000)
GetAllHolding AccountCode
End SubSub EndManage '停止管理
Application.KillTimer(5)
Set objExcel=Nothing
End SubSub 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 SubSub 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
'未完，待續 - 用戶回復：
'這里的代碼接著上面的，放在上面模塊下方。
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 MarketOn 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 SubSub GetContract(sCode,sMarket) '獲取合約的信息
Call Order.Contract(sCode,sMarket,Multipliter,MinTick,ShortPercent,LongPercent)
End SubSub 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 - 網友回復：
精華 這個牛
- 網友回復： 很強大，很強大
如果以上指標公式不適用于您常用的行情軟件
或者您想改編成選股公式，以便快速選出某種形態個股的話，
可以聯系我們相關技術人員 QQ: 262069696 進行 有償 改編！
- 上一篇：區間判斷程序求編
- 下一篇：模擬賬戶能使用ORDER嗎？
相關文章
-
沒有相關內容
會員登錄/注冊