如何比较数组对象以汇总值？

In this macro I am comparing all of our company's customer accounts that have been affected on a specific date (previous day) to all of our reported payments from our bank statement. I use a VLookup to compare each customer amount in the bank statement column and visa-versa with bank records to customer accounts.

在此宏观中,我将我们公司在特定日期(前一天)受影响的所有客户帐户与我们在银行对帐单中报告的所有付款进行比较。我使用VLookup来比较银行对帐单栏中的每个客户金额,反之亦然,将银行记录与客户帐户进行比较。

I take the ones that are unapplied (those that report an error in the VLookup - ErrorHandler: and ErrorHandler2:) and modify a dynamic Array to store their values (GPMissing1() for Customer Name and GPMissing2() for Customer Amounts)

我接受那些未应用的(那些报告错误的VLookup - ErrorHandler:和ErrorHandler2 :)并修改动态数组来存储它们的值(GPMissing1()用于客户名称,GPMissing2()用于客户金额)

Sub GPWireDifference()
    Dim GPMissing1() As String, GPMissing2() As Double, GPCount As Integer

    GPMissingString = ""
    Cells.EntireColumn.AutoFit
    Range("B:E").NumberFormat = "$#,##0.00"
    Range("D2").Activate

    On Error GoTo ErrorHandler:
    Do Until ActiveCell.Offset(0, -3).Value = ""
        ActiveCell.Value = Application.WorksheetFunction. _
            IfError(Application.WorksheetFunction. _
                VLookup(ActiveCell.Offset(0, -2), Range("C:C"), 1, False), 0)


        ActiveCell.Offset(1, 0).Activate
        If ActiveCell.Row = 300 Then
            Exit Sub
        End If

    Loop
    ErrorHandler:
        If Not ActiveCell.Offset(0, -3).Value = "" Then
            GoTo ErrorHandler2:
        End If
    ErrorHandler2:
        If Not ActiveCell.Offset(0, -3).Value = "" Then
            ReDim Preserve GPMissing1(GPCount)
            ReDim Preserve GPMissing2(GPCount)
            GPMissing1(GPCount) = ActiveCell.Offset(0, -3).Value
            GPMissing2(GPCount) = ActiveCell.Offset(0, -2).Value
            GPCount = GPCount + 1
            Resume Next
        End If

    For x = 0 To GPCount - 1
        If x > 0 Then
            GPMissingString = GPMissingString & vbCr & GPMissing1(x) & " - " & GPMissing2(x)
        Else
            GPMissingString = GPMissing1(x) & " - " & GPMissing2(x)
        End If
    Next
    Cells.EntireColumn.AutoFit
    If GPCount > 0 Then MsgBox GPMissingString

End Sub

In the end, it displays a MsgBox to alert the user of all accounts that have been affected but are not reflected in the bank statement.

最后,它显示一个MsgBox,以警告用户所有受影响但未反映在银行对帐单中的帐户。

Example Message:

In Great Plains But Not In Bank Statement:
    Rod Powers - $196.40           'Array Object 0 - Array Object 0
    Rod Powers - $394.40           'Array Object 1 - Array Object 1
    Tod Dindino - $1,190.40        'Array Object 2 - Array Object 2
    Rod Powers - $2,752.80         'Array Object 3 - Array Object 3
    Tod Dindino - $12,518.75       'Array Object 4 - Array Object 4

Since these are two separate arrays, yet each array position matches its respective value in the other array, how would I be able to summarize each message to show:

由于这些是两个独立的数组,但每个数组位置与其他数组中的相应值相匹配,我如何能够汇总每个消息以显示:

In Great Plains But Not In Bank Statement:
    Rod Powers - $3,343.60          
    Tod Dindino - $13,709.15

(We received bank wires for customer orders and sometimes the customer sends a single wire to reflect multiple orders. This summation would allow me to then further compare a wire for the summation of single customer names rather than line by line values. I.e. I can compare the total of Rod Powers to his single wire, versus his 3 individual orders vs his wire which obviously returns as a missing value)

(我们收到客户订单的银行电汇,有时客户发送一条电汇以反映多个订单。这个总和将允许我进一步比较单个客户名称总和而不是逐行值的电汇。即我可以比较Rod Powers的总数达到他的单线,相比之下,他的3个单独的订单与他的电线相比,这显然是一个缺失值

Here's an example of what the sheet will look like:

以下是工作表的外观示例:

SOLUTION/FIXED:

As per Mat's Mug's help, I have eliminated the use of a dynamic array and switched it to a Dictionary. This allowed me to create a total sum of all repeated names and further compare to any values on the bank statement.

根据Mat的Mug的帮助,我已经消除了动态数组的使用并将其切换为字典。这使我能够创建所有重复名称的总和,并进一步与银行对帐单上的任何值进行比较。

Sub GPWireDifference()

    Dim values As Dictionary
    Set values = New Dictionary

    Dim lookup As String
    Dim amount As Currency
    lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    GPMissingString = ""

    Cells.EntireColumn.AutoFit
    Range("B:E").NumberFormat = "$#,##0.00"
    Range("D2").Activate

    On Error GoTo ErrorHandler:
    Do Until ActiveCell.Offset(0, -3).Value = ""
        ActiveCell.Value = Application.WorksheetFunction. _
            IfError(Application.WorksheetFunction. _
                VLookup(ActiveCell.Offset(0, -2), Range("C:C"), 1, False), 0)
        ActiveCell.Offset(1, 0).Activate
    Loop

    ErrorHandler:
        If Not ActiveCell.Offset(0, -3).Value = "" Then
            GoTo ErrorHandler2:
        End If

    ErrorHandler2:
        If Not ActiveCell.Offset(0, -3).Value = "" Then
            lookup = ActiveCell.Offset(0, -3).Value
            amount = ActiveCell.Offset(0, -2).Value
            If values.Exists(lookup) Then
                values(lookup) = values(lookup) + amount
            Else
                values.Add lookup, amount
            End If
            Resume Next
        End If

    For x = 0 To values.Count - 1
        If x > 0 Then
            GPMissingString = GPMissingString & vbCr & values.Keys(x) & " - " & _
                Format(values.Items(x), "$#,##0.00")values.Items(x)
        Else
            GPMissingString = values.Keys(x) & " - " & _
                Format(values.Items(x), "$#,##0.00")values.Items(x)
        End If
    Next
    Cells.EntireColumn.AutoFit
    If values.Count > 0 Then MsgBox GPMissingString

End Sub

Thank you everyone! I'm blown away by how much and how quickly y'all have been able to help me through the years!

谢谢大家!多年来我们能帮助我多少和多快,我感到震惊!

2 个解决方案

#1

Array lookup is going to be O(n), which means the more items there are, the longer the lookup is going to be.

数组查找将是O(n),这意味着项目越多,查找的时间就越长。

Make yourself a Dictionary object (reference the Microsoft Scripting Runtime library for early-binding) instead - a dictionary key lookup is O(1), which means lookup time remains constant regardless of how many items there are:

使自己成为一个Dictionary对象(引用Microsoft Scripting Runtime库进行早期绑定) - 字典键查找为O(1),这意味着无论有多少项,查找时间都保持不变:

Dim values As Dictionary
Set values = New Dictionary

Dim lookup As String
Dim amount As Currency

For row = 2 To lastRow
     lookup = Sheet1.Range("A" & row).Value
     amount = Sheet1.Range("B" & row).Value
     If values.Exists(lookup) Then
         values(lookup) = values(lookup) + amount
     Else
         values.Add lookup, amount
     End If
Next

A Collection can also be keyed, but the keys cannot be retrieved or iterated, and its members are just too bare-bones; a Dictionary will do a much better job.

集合也可以是键控的,但是密钥不能被检索或迭代,并且它的成员太过简单;字典会做得更好。

#2

The trivial way would be to search the name array to see if the name exists, and if it does then add the value to the existing value instead of inserting a new array member

琐碎的方法是搜索名称数组以查看名称是否存在,如果存在,则将值添加到现有值,而不是插入新的数组成员

#1