根据多个条件计算不同的值

Question

我的 Excel 工作簿有一个 table 包含大约 50K 条记录。我目前正在使用一个公式来计算基于两个标准的不同值，即：ID & Region

通过公式执行此操作会使我的工作簿非常慢。因此，我想知道您是否知道如何将其转换为高效的 VBA 循环。

.Range("C2").Formula = "=IF(IFERROR(1=SUMPRODUCT(1/COUNTIFS($A:A2,A2,$B:B2,B2)),0),1,0)"

C 列中的所需结果。VBA 代码必须能够通过用“1”标记 C 列来突出显示唯一值。当遇到重复条目时，代码只能将范围的最后一个条目标记为唯一“1”（参见 ID 3）。

Answer 1

独一无二'Descending'

假设table（一行headers）从单元格A1开始，并且header已经写在第一个单元格中目标（结果）列 (dCol).
调整工作表名称 (wsName) 和目标列 (dCol)。
Delimiter 必须是数据中不包含的字符串。

Option Explicit

Sub GetUnique()
    
    Const wsName As String = "Sheet1"
    Const dCol As String = "C"
    Const Delimiter As String = "|"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    
    Dim srg As Range
    With ws.Range("A1").CurrentRegion
        Set srg = .Resize(.Rows.Count - 1, 2).Offset(1)
    End With
    Dim sData As Variant: sData = srg.Value
    
    Dim rCount As Long: rCount = srg.Rows.Count
    Dim dData As Variant: ReDim dData(1 To rCount, 1 To 1)
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim r As Long
    Dim cString As String
    
    For r = rCount To 1 Step -1
        cString = sData(r, 1) & Delimiter & sData(r, 2)
        If dict.Exists(cString) Then
            dData(r, 1) = 0
        Else
            dict.Add cString, Empty
            dData(r, 1) = 1
        End If
    Next r
    
    Dim drg As Range: Set drg = srg.Resize(, 1).EntireRow.Columns(dCol)
    drg.Value = dData

    With drg
        .Resize(ws.Rows.Count - rCount - 1).Offset(rCount).ClearContents
    End With
    
End Sub

根据多个条件计算不同的值

Count distinct values based on multiple criteria

excel

vba

distinct

countif

独一无二'Descending'