Question

我有一个包含以下列的交易列表。有超过数千行的交易。我需要在30天内查找至少有12个或更多相同AccountName的交易，其总金额超过10,000美元。请帮忙。我不知道怎么开始。我本周才开始关注VBA。这将在Excel中使用Macro。

交易ID;量;日期;帐户名

希望这是有道理的。我正在寻找12个或更多具有相同帐户名的交易，该帐户名在30天内总计超过10,000美元。

非常感谢!!

Answer 1

由于Recordset属性的灵活性，我建议使用ADO recordset.Filter。我最多只能使用它来遍历源表的每一行。逻辑如下：

将源数据导入Recordset。
过滤Recordset，仅包含具有相同“AccountName”的记录。
如果过滤集中有超过12条记录（即交易，这是您的要求之一），则继续。否则，请更新过滤器以排除此“AccountName”并获取下一个。
在交易的第一天和最后一天之间的每一天创建一个包含一个元素的数组，并将当天的交易总和存储在其中。
保留前30天总计的运行总和。如果总金额超过10000美元，请存储“AccountName”，30天窗口的开始日期和交易总额。
重置Recordset过滤器以排除先前处理的帐户并处理下一个帐户 “帐户名”。
当所有'AccountName'都已处理完毕后，创建一个新的工作表并将结果复制到其中。

代码会读取包含至少三列数据的电子表格：“金额”，“日期”和“帐户名称”。见下文：

Option Explicit

Sub AggregateWithinWindow()
    Dim xlXML As Object     'MSXML2.DOMDocument
    Dim rs As Object        'ADODB.Recordset
    Dim ws As Worksheet
    Dim rng As Range
    Dim colResults As Collection
    Dim dblRunSum As Double
    Dim aDaySums() As Double
    Dim ar(2) As Variant
    Dim sFltr As String, sAcctName As String
    Dim lDateLow As Long, lDateHigh As Long, lWndLow As Long, i As Long, j As Long

    ' Get the data from the spreadsheet into an ADO Recordset using the approach shown by kulshresthazone at http://usefulgyaan.wordpress.com/
    Set rng = Application.ActiveSheet.UsedRange
    Set rs = CreateObject("ADODB.Recordset")
    Set xlXML = CreateObject("MSXML2.DOMDocument")
    xlXML.LoadXML rng.Value(xlRangeValueMSPersistXML)
    rs.Open xlXML
    Set rng = Nothing
    Set xlXML = Nothing


    Set colResults = New Collection

    rs.Sort = "[Date] ASC"

    sAcctName = rs.Fields("AccountName").Value
    rs.Filter = "[AccountName] = '" & sAcctName & "'"

    Do While Not rs.EOF
        If rs.RecordCount >= 12 Then
            rs.MoveLast
            lDateHigh = CLng(rs.Fields("Date").Value)
            rs.MoveFirst
            lDateLow = CLng(rs.Fields("Date").Value)
            ReDim aDaySums(lDateHigh - lDateLow)

            dblRunSum = 0
            lWndLow = 0
            sAcctName = rs.Fields("AccountName").Value

            Do While Not rs.EOF
                i = CLng(rs.Fields("Date").Value) - lDateLow
                Do While Not rs.EOF
                    If CLng(rs.Fields("Date")) - lDateLow = i Then
                        aDaySums(i) = aDaySums(i) + rs.Fields("Amount").Value
                        rs.MoveNext
                    Else
                        Exit Do
                    End If
                Loop

                If i - lWndLow <= 30 Then
                    dblRunSum = dblRunSum + aDaySums(i)
                Else
                    If dblRunSum > 10000 Then
                        ar(0) = sAcctName
                        ar(1) = CDate(lWndLow + lDateLow)
                        ar(2) = dblRunSum
                        colResults.Add ar
                    End If

                    dblRunSum = dblRunSum + aDaySums(i)

                    For j = lWndLow To i - 31
                        dblRunSum = dblRunSum - aDaySums(j)
                    Next j

                    lWndLow = i - 30
                End If
            Loop
        End If
        If sFltr = "" Then
            sFltr = "[AccountName] <> '" & sAcctName & "'"
        Else
            sFltr = sFltr & " and [AccountName] <> '" & sAcctName & "'"
        End If
        rs.Filter = sFltr
        If Not rs.EOF Then rs.Filter = sFltr & " and [AccountName] = '" & rs.Fields("AccountName").Value & "'"
    Loop

    rs.Close
    Set rs = Nothing

    Set ws = Application.ActiveWorkbook.Sheets.Add
    ws.Name = "Results"

    ws.Cells(1, 1).Value = "AccountName"
    ws.Cells(1, 2).Value = "WindowStartDate"
    ws.Cells(1, 3).Value = "WindowAggregate"

    For i = 1 To colResults.Count
        ws.Range(ws.Cells(i + 1, 1), ws.Cells(i + 1, 3)) = colResults.Item(i)
    Next i

    Set ws = Nothing

End Sub

在30天内找到交易

1 个答案: