[已解决]请高手帮忙指点根据条件求和的问题

ccsc006

要求附件：
1、同一个“资金号码”下，对于“同一个品种”，要在”买卖方向“上出现过两次。即买、卖各一次
满足这个条件下，对”结算金额“求和。
2、对于不满足 1 的行进行删除。

最佳答案

月排行榜 / 总排行榜

tsigms

2012-4-20 22:11

Sub a()
    Dim ar, br(), di, dk
    Dim i&, j&
    Dim d As New Dictionary
    ar = [A1].CurrentRegion
    For i = 2 To UBound(ar)
        d(ar(i, 1) & "," & ar(i, 2)) = d(ar(i, 1) & "," & ar(i, 2)) + IIf(ar(i, 3) = "买入", 1, -1)
    Next i
    For i = 2 To UBound(ar)
        If d(ar(i, 1) & "," & ar(i, 2)) = 0 Or Abs(d(ar(i, 1) & "," & ar(i, 2))) <> 1 Then
            d(ar(i, 1) & "," & ar(i, 2)) = d(ar(i, 1) & "," & ar(i, 2)) + ar(i, 5)
        Else
            d.Remove ar(i, 1) & "," & ar(i, 2)
        End If
    Next i
    ReDim br(0 To d.Count - 1)
    dk = d.Keys
    For i = 0 To d.Count - 1
        br(i) = Split(dk(i), ",")
    Next i
    [G10].Resize(UBound(br) + 1, 2) = Application.Transpose(Application.Transpose(br))
    [I10].Resize(UBound(br) + 1, 1) = Application.Transpose(d.Items)
End Sub

跳转到最佳答案楼层

tsigms

Sub a()
    Dim ar, br(), di, dk
    Dim i&, j&
    Dim d As New Dictionary
    ar = [A1].CurrentRegion
    For i = 2 To UBound(ar)
        d(ar(i, 1) & "," & ar(i, 2)) = d(ar(i, 1) & "," & ar(i, 2)) + IIf(ar(i, 3) = "买入", 1, -1)
    Next i
    For i = 2 To UBound(ar)
        If d(ar(i, 1) & "," & ar(i, 2)) = 0 Or Abs(d(ar(i, 1) & "," & ar(i, 2))) <> 1 Then
            d(ar(i, 1) & "," & ar(i, 2)) = d(ar(i, 1) & "," & ar(i, 2)) + ar(i, 5)
        Else
            d.Remove ar(i, 1) & "," & ar(i, 2)
        End If
    Next i
    ReDim br(0 To d.Count - 1)
    dk = d.Keys
    For i = 0 To d.Count - 1
        br(i) = Split(dk(i), ",")
    Next i
    [G10].Resize(UBound(br) + 1, 2) = Application.Transpose(Application.Transpose(br))
    [I10].Resize(UBound(br) + 1, 1) = Application.Transpose(d.Items)
End Sub

tsigms

楼主不要光评分啊，给个最佳答案撒