VBA 更改字典值

Question

我试图动态更改字典中的值。 如果字典中存在值，则将该值更改为字典值 + 新值（增量）。

但是，我无法执行此操作，我收到运行时错误 451：未定义属性让过程且属性获取过程未返回对象。 有人可以帮我对字典进行“sumifs”类型的更改吗？

Sub Sumifs()

Dim objDictionary
Set objDictionary = CreateObject("Scripting.Dictionary")
Dim arr As Variant
Dim lr1 As Long
Dim arr2 As Variant
Dim lr2 As Long

With Blad15
        lr1 = Worksheets("Sheet1").Cells(.Rows.Count, 5).End(xlUp).Row
        arr = Worksheets("Sheet1").Range("E20:E" & lr1)
        Debug.Print UBound(arr)
        Debug.Print lr1
End With

ThisWorkbook.Sheets("Sheet1").Select
For i = 1 To UBound(arr)
    objDictionary.Add Key:=CStr(Cells(i + 19, 5)), Item:=CStr(Cells(i + 19, 5))
Next

ThisWorkbook.Sheets("Sheet2").Select

    With Blad6
        lr2 = Worksheets("Sheet2").Cells(.Rows.Count, 2).End(xlUp).Row
        arr2 = Worksheets("Sheet2").Range("B2:B" & lr2 + 1)

    End With

For i = 1 To UBound(arr)
    If objDictionary.Exists(Cells(i + 1, 2).Value) Then
        objDictionary(Cells(i + 1, 2).Value) = objDictionary.Items(Cells(i + 1, 2)) + Worksheets("Sheet2").Cells(i + 1, 8).Value 'Error occurs here
    End If

Next


End Sub

Answer 1

根据您的评论和屏幕截图，我是这样理解的：

我用下面的代码创建了一个新的类模块customer

Option Explicit

Public customerName As String
Public invoiceAmount As Double
Public cashReceived As Double

然后我使用以下代码创建了一个新模块来创建摘要

    Sub CreateSummary()

    Dim dict As Dictionary
    Dim rgInvoices As Range

    Set rgInvoices = Worksheets("Invoices sent").Range("A1").CurrentRegion
    Set rgInvoices = rgInvoices.Offset(1).Resize(rgInvoices.Rows.Count - 1)

    Dim sngRow As Range
    Dim oneCustomer As customer

    Set dict = New Dictionary
    Dim customerName As String
    Dim amount As Double

    ' Sum up the invoice amount for each single customer
    For Each sngRow In rgInvoices.Rows

        customerName = sngRow.Cells(1, 1).Value
        amount = sngRow.Cells(1, 3).Value

        If dict.Exists(sngRow.Cells(1, 1).Value) Then
            dict(customerName).invoiceAmount = dict(customerName).invoiceAmount + amount
        Else
            Set oneCustomer = New customer
            With oneCustomer
                .customerName = customerName
                .invoiceAmount = amount
            End With
            dict.Add oneCustomer.customerName, oneCustomer
        End If

    Next sngRow



    Dim rgCashReceived As Range
    Set rgCashReceived = Worksheets("Cash received").Range("A1").CurrentRegion
    Set rgCashReceived = rgCashReceived.Offset(1).Resize(rgCashReceived.Rows.Count - 1)


    ' Sum up the cash received for each single customer
    For Each sngRow In rgCashReceived.Rows

        customerName = sngRow.Cells(1, 1).Value
        amount = sngRow.Cells(1, 3).Value


        If dict.Exists(sngRow.Cells(1, 1).Value) Then
            dict(customerName).cashReceived = dict(customerName).cashReceived + amount
        Else
            Set oneCustomer = New customer
            With oneCustomer
                .customerName = customerName
                .cashReceived = amount
            End With
            dict.Add oneCustomer.customerName, oneCustomer
        End If

    Next sngRow

    ' Print Out
    Dim vKey As Variant
    Dim i As Long
    Dim shOut As Worksheet
    Set shOut = Worksheets("Summary")


    ' Heading
    With shOut
        .Cells(1, 1).CurrentRegion.Clear
        .Cells(1, 1).Value = "Customer Name"
        .Cells(1, 2).Value = "Invocie amount"
        .Cells(1, 3).Value = "Cash received"

        ' single rows
        i = 2
        For Each vKey In dict.Keys
            Debug.Print vKey, dict(vKey).invoiceAmount, dict(vKey).cashReceived
            .Cells(i, 1).Value = vKey
            .Cells(i, 2).Value = dict(vKey).invoiceAmount
            .Cells(i, 3).Value = dict(vKey).cashReceived
            i = i + 1
        Next vKey

    End With

End Sub

编译错误的解决方法：用户定义类型未定义下划线Dim dict As dictionary从 Visual Basic 菜单中选择工具->参考。 选中“Microsoft Scripting Runtime”旁边的框

尽管问题仍然存在：您为什么不使用 SUMIF 中内置的 excel？

你也可以试试Macromastery的第二个例子