Excel - 计算与 ID 匹配的唯一值，针对 100,000 多个案例进行了优化

Question

引用下面的 Excel 屏幕截图，我正在寻找一个公式解决方案，计算 A 列中每个 ID 号在 B 列(颜色)中的唯一值的数量。

我已将所需结果归因于 C 列。因此，例如，ID 1 (A2) 只有一种独特的颜色，即灰色 (B2)，它将在 C2 中返回 1。 ID 2 只有一种独特的颜色，黄色(B3、B4)，并在 C3 和 C4 中返回 1。 ID 3，有两种独特的颜色，蓝色和紫色，因此在 C5 到 C8 中返回 2。等等

因为这将针对接近 100,000 行运行，所以我遇到的许多基于索引和/或匹配的解决方案都需要很长时间才能计算。我发现所有按升序排列的 ID 值都可以通过使用 =IF(A2=A1 或类似的东西开始公式来加快速度。提前感谢任何对如何做有一些想法的人用精益公式解决这个问题。

注意:我正在处理也有将近 100 列的文件。不需要辅助列的解决方案将是理想的。

编辑/添加:在我的主数据文件中，B 列中有空白单元格的实例。在计算 C 列结果时有没有办法忽略空白单元格？

Answer 1

这是一个 VBA 例程，它应该针对该数量的条目快速运行。我们创建了一个类模块(用户定义的对象)，它由与每个 ID 相关联的颜色集合(字典)和该颜色的计数组成。 (并不是真的需要计数，但添加它是微不足道的，以防您出于其他目的需要它；也可以作为一些可以完成的演示)。

然后我们将结果输出到相邻的列中，如您在屏幕截图中所示。结果可以在其他地方输出，甚至可以在不同的工作表上输出，只需稍作代码更改。

请务必阅读模块开头的注释，了解重要信息和正确设置。

类模块

---

Option Explicit
'RENAME this module:  cID

Private pID As String
Private pColor As String
Private pColors As Dictionary

Public Property Get ID() As String
    ID = pID
End Property
Public Property Let ID(Value As String)
    pID = Value
End Property

Public Property Get Color() As String
    Color = pColor
End Property
Public Property Let Color(Value As String)
    pColor = Value
End Property

Public Property Get Colors() As Dictionary
    Set Colors = pColors
End Property
Public Function ADDColor(Value As String)
    'Might as well also count # of times this color assigned
    If Not pColors.Exists(Value) Then
        pColors.Add Key:=Value, Item:=1
    Else
        pColors(Value) = pColors(Value) + 1
    End If
End Function

Private Sub Class_Initialize()
    Set pColors = New Dictionary
End Sub

---

常规模块

编辑(编辑以消除空白行的计数)

---

Option Explicit
'Set reference to Microsoft Scripting Runtime (Tools/References)

Sub IDColorCount()
    Dim cID As cID, dID As Dictionary
    Dim wsData As Worksheet, rData As Range
    Dim vData As Variant, vRes As Variant
    Dim I As Long

'Set the data worksheet and range
'Read the data into an array for faster calculations
Set wsData = Worksheets("sheet1")
With wsData
    Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=2)
    vData = rData
End With

'Go through the data and collect the information
Set dID = New Dictionary
For I = 2 To UBound(vData, 1)
  If Not vData(I, 1) = "" Then
    Set cID = New cID
    With cID
        .ID = vData(I, 1)
        .Color = vData(I, 2)
        .ADDColor .Color

        If Not dID.Exists(.ID) Then
            dID.Add Key:=.ID, Item:=cID
        Else
            dID(.ID).ADDColor .Color
        End If
    End With
  End If
Next I

'Size the results array
ReDim vRes(1 To UBound(vData), 1 To 1)
vRes(1, 1) = "Count"
For I = 2 To UBound(vData, 1)
    If Not vData(I, 1) = "" Then _
        vRes(I, 1) = dID(CStr(vData(I, 1))).Colors.Count
Next I

'The results can  be written anyplace
With rData.Offset(0, 2).Resize(columnsize:=1)
    .EntireColumn.Clear
    .Value = vRes
End With

End Sub

---