Question

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

我选择那些未应用的（那些报告错误的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

最后，它会显示一个MsgBox，提醒用户所有受影响但未反映在银行对帐单中的帐户。

示例消息：

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

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

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

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

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

解决方案/固定：

根据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

谢谢大家！多年来，我一直能够帮助我多少和多快，我感到很震惊！

Answer 1

数组查找将 O（n） ，这意味着项目越多，查找的时间就越长。

让自己成为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

也可以键入Collection，但是无法检索或迭代密钥，其成员只是过于简单; Dictionary会做得更好。

Answer 2

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

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

2 个答案: