- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 0
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2024-11-14
|
2#
發表於 2013-12-2 00:02
| 只看該作者
回復 1# wwxscl - Private Sub cbCal_Click()
- Dim iI%, iJ%
- Dim lRow&(0 To 1)
- Dim sStr$
- Dim vB, vS, vM ' 買進張數,賣出張數,差價(+買-賣)
- Dim vK, vBI, vSI, vMI
-
- Set vB = CreateObject("Scripting.Dictionary")
- Set vS = CreateObject("Scripting.Dictionary")
- Set vM = CreateObject("Scripting.Dictionary")
-
- lRow(0) = 4
- With Sheets("Sheet1")
- Do While .Cells(lRow(0), 2) <> ""
- For iI = 0 To 1
- If .Cells(lRow(0), 2 + iI * 6) <> "" Then
- With .Cells(lRow(0), 2 + iI * 6)
- sStr = Mid(.Text, 7)
- vM(sStr) = vM(sStr) + (.Offset(, 2) * .Offset(, 1)) - (.Offset(, 3) * .Offset(, 1))
- vB(sStr) = vB(sStr) + (.Offset(, 2) / 1000)
- vS(sStr) = vS(sStr) + (.Offset(, 3) / 1000)
- End With
- End If
- Next iI
- lRow(0) = lRow(0) + 1
- Loop
- End With
-
- vK = vB.keys
- vBI = vB.items
- vSI = vS.items
- vMI = vM.items
- lRow(0) = 3
- lRow(1) = 3
- With Sheets("Sheet2")
- .Select
- For iI = 0 To vM.Count - 1
- iJ = -(vMI(iI) < 0)
- .Cells(lRow(iJ), 1 + (iJ * 6)) = vK(iI)
- .Cells(lRow(iJ), 2 + (iJ * 6)) = vBI(iI)
- .Cells(lRow(iJ), 3 + (iJ * 6)) = vSI(iI)
- .Cells(lRow(iJ), 4 + (iJ * 6)) = Abs(vBI(iI) - vSI(iI))
- If vBI(iI) - vSI(iI) = 0 Then
- .Cells(lRow(iJ), 5 + (iJ * 6)) = 0
- Else
- .Cells(lRow(iJ), 5 + (iJ * 6)) = Abs(vMI(iI) / (vBI(iI) - vSI(iI))) / 1000
- End If
- lRow(iJ) = lRow(iJ) + 1
- Next
- End With
- End Sub
複製代碼
1128-3498-a.zip (61.53 KB)
|
|