找到30天內的交易

Question

我有一個交易列表下面的列。有成千上萬的交易行。我需要在30天內找到至少有12個或更多相同AccountName的交易，總計金額超過10,000美元。請幫忙。我不知道如何開始。本週我剛開始考慮VBA。這將在Excel中使用宏。

交易ID;量;日期; AccountName

希望這是有道理的。 我在30天的時間內尋找12個或更多具有相同帳戶名稱的交易，總計金額超過10,000美元。

非常感謝你！

Answer 1

由於recordset.Filter屬性的靈活性，我推薦使用ADO Recordset。我能夠使用它遍歷源表的每一行，最多隻有一次。 邏輯如下：

• 將源數據獲取到Recordset中。
• 將記錄集過濾爲只包含具有相同'AccountName'的記錄。
• 如果Filtered集中有超過12條記錄（即交易，這是您的要求之一），則繼續。否則，更新過濾器以排除此'AccountName'並獲取下一個。
• 在交易的第一天和最後一天之間爲每一天創建一個元素，並將當天的交易總和存儲在該交易中。
• 保留前30天的總計金額的運行總和。如果總數超過10000美元，則存儲'賬戶名'，30天窗口的開始日期和交易總額。
• 重置記錄集過濾器以排除先前處理的帳戶並處理下一個 '帳戶名'。
• 當所有的'AccountName'已經被處理時，創建一個新的Worksheet並將結果複製到它。

該代碼讀取至少包含三列數據的電子表格：「金額」，「日期」和「帳戶名」。見下：

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