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

Question

我的 Excel 工作簿有一个包含大约 5 万条记录的表格。我目前正在使用一个公式根据两个标准计算不同的值，即：ID & Region

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

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

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

Answer 1

独特的“降序”

• 假设表格（一行标题）从单元格 A1 开始，并且标题已经写入目标（结果）列 (dCol) 的第一个单元格。< /li>
• 调整工作表名称 (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