vba - 使用字典作为另一个字典中的项目来计算唯一值

Question

这是我想要实现的目标:

我在 DA 列中有一个 ID。我在 CB 列中有一个产品。我想计算每个 ID 的唯一产品数量(ID 可以有多行)。然后我想将唯一产品的数量写入新列(DB)。

我的逻辑是写两本字典。 “主”字典将与 ID 关联，第二个字典将与我的产品关联。在主字典中，如果键存在，我会将该项检索到 dict 对象中，如果不存在，那么我将重写主字典。

在此之后，我正在考虑使用 .count 函数来告诉我每个 ID 存在多少个唯一值。

我一直在尝试调整一些代码来满足我的需求。这是我目前拥有的:

Sub Find_Unique_Product_Number()

    Dim LastRow As Long

    LastRow = Worksheets("Orders").Range("A" & Rows.Count).End(xlUp).Row
    adata = Worksheets("Orders").Range("A1:DB" & LastRow)

    Set dicTwoProds = CreateObject("Scripting.Dictionary")     'Late binding    creation of dictionary
        For LastRow = LBound(adata, 1) To UBound(adata, 1)
            sKey1 = adata(LastRow, 80)
            If Not dicTwoProds.Exists(sKey) Then
                Set dicItem = CreateObject("Scripting.Dictionary")

                dicTwoProds.Add sKey1, aItem

                sKey1 = Worksheets("Orders").Range("CB2:CB" & LastRow)           'Product
                dicTwoProdsItem.Add sKey1, ""                              

            Else
                Set dicItem = dicTwoProd.Item(sKey)
                sKey2 = Worksheets("Orders").Range("CB2:CB" & LastRow)                                              'Product
                If Not dicItem.Exists(sKey2) Then
                    dicItem.Add sKey2, ""                            
                    dicTwoProds.Item(sKey) = aItem
                End If
            End If
    Next

End Sub

当前此代码在此行引发“需要对象”错误:dicTwoProdsItem.Add sKey1, ""

我猜我的部分问题是我如何在 sKey 行上使用 .range？我不确定该语法应该如何。

我还不确定如何将 .count 结果写入工作表。

我确实有一个数组公式可以满足我的需要，它是: '=SUM(IF(DA5=DA2:DA100,1/(COUNTIFS(DA2:DA100,DA5,CB2:CB100,CB2:CB100)),0))

该公式非常慢，这是我想使用字典的部分原因。如果字典解决方案不起作用，我希望获得有关使用 VBA 将数组公式放入工作表上的列 DB 的语法方面的帮助。

在所描述的场景中，所有数据都位于同一个工作表上。

干杯!

Answer 1

您可以使用单个字典来计算每个ID的唯一产品的数量。

诀窍是将 id 与产品连接起来以创建唯一的 key :

Dim dict As Object, lastRow As Long, r As Long, ids(), products(), dupIds()
Set dict = CreateObject("Scripting.Dictionary")

lastRow =  Worksheets("Orders").Cells(Rows.Count, 1).End(xlUp).Row
ids =      Worksheets("Orders").Range("DA2:DA" & lastRow).Value
products = Worksheets("Orders").Range("CB2:CB" & lastRow).Value

' map the id to each unique id/product '

For r = LBound(ids) To UBound(ids)
    dict(ids(r, 1) & products(r, 1)) = CStr(ids(r, 1))
Next

' map the count of products to each unique id '

dupIds = dict.Items
dict.RemoveAll

For r = LBound(dupIds) To UBound(dupIds)
    dict(dupIds(r)) = dict(dupIds(r)) + 1
Next

' build the column holding the count of products '

For r = LBound(ids) To UBound(ids)
    products(r, 1) = dict(CStr(ids(r, 1)))
Next

Worksheets("Orders").Range("DB2:DB" & lastRow).Value = products