根据另一列中给出的条件计算唯一值

Question

我有一个列表，列出了正在制造的批次和零件号。
我需要在一台机器上运行的批次的唯一计数。 此长列表每天更新。 我在这里附上一个例子。

我有这个粗糙的代码。

last_row = ws.Cells(Rows.Count,1).End(xlUp).Row
For Each M_cCell in M_cRange
    Counter = 0
    For i = 2 to last_row
        If Cells(1, 1).Value = M_cCell Then
            Counter = Counter + (1/(WorksheetFunction.CountIF _
            (Range(Cells(2,2),Cells(Last_row,2),M_ccell.Value)))
        End If
    Next i
Next M_cCell

这会以十进制数字给出不希望的结果。

Answer 1

假设： A：C列中的数据b。 数据表中唯一使用的范围是A：C c列。 结果将在范围（“ E1”）中打印

考虑到需要大量数据，使用字典可能是删除重复项的最有效方法之一。 让我知道是否有帮助。

Sub test()
    Dim dictMachine As Object: Set dictMachine = CreateObject("scripting.dictionary")
    Dim dictBatch As Object
    Dim vTemp As Variant: vTemp = ActiveSheet.UsedRange
    Dim vTemp2 As Variant
    Dim i As Long


    For i = LBound(vTemp, 1) + 1 To UBound(vTemp, 1)
        Set dictBatch = CreateObject("scripting.dictionary")
        If dictMachine.exists(vTemp(i, 1)) Then
            dictMachine(vTemp(i, 1))(vTemp(i, 2)) = dictMachine(vTemp(i, 1))(vTemp(i, 2)) + 1
        Else
            dictBatch(vTemp(i, 2)) = dictBatch(vTemp(i, 2)) + 1
            Set dictMachine(vTemp(i, 1)) = dictBatch
        End If
    Next i

    vTemp = dictMachine.Keys
    ReDim vTemp2(0 To UBound(vTemp, 1) + 1, 0 To 1)
    vTemp2(0, 0) = "Machine"
    vTemp2(0, 1) = "Number of Batches"
    For i = LBound(vTemp, 1) To UBound(vTemp, 1)
        vTemp2(i + 1, 0) = vTemp(i)
        vTemp2(i + 1, 1) = dictMachine(vTemp(i)).Count
    Next i

    ActiveSheet.Range("E1").Resize(UBound(vTemp2, 1) - LBound(vTemp2, 1) + 1, UBound(vTemp2, 2) - LBound(vTemp2, 2) + 1) = vTemp2


End Sub

Answer 2

也不是最干净的方法，但是您可以完全避免循环，而在使用AdvancedFilter之后仅使用COUNTIF -在处理大量数据时，与循环相比，这是非常有效的。

Public Sub Test()
    Dim TargetSheet As Worksheet

    Set TargetSheet = Worksheets("Sheet2")

    With ActiveSheet
        .Range("A1:B20").AdvancedFilter xlFilterCopy, CopyToRange:=TargetSheet.Range("A1"), Unique:=True 'Get unique combinations
    End With

    With TargetSheet
        .Range("A1:A" & .Range("A1").End(xlDown).Row).AdvancedFilter xlFilterCopy, CopyToRange:=.Range("C1"), Unique:=True 'Get unique machines
        .Range("D2").Value = "=countif(A:A, C2)" 'Count batches per machine
        .Range("D2").AutoFill .Range("D2:D" & .Range("C2").End(xlDown).Row)


        .Range("D1").Value = "Count of batches:" 'Add count header 
        .Range("D:D").value = .Range("D:D").value 'replace formula's by values.    
        .Range("A:B").Delete shift:=xlToLeft 'Get rid of helper columns from first advanced filter.
    End With

    Set TargetSheet = Nothing
End Sub

Answer 3

另一个解决方案：

Sub Demo()
    Dim rng As Range

    For Each rng In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        Cells(rng.Row(), "E").Value = Evaluate(Replace("IFERROR(INDEX($A$2:$A$15,MATCH(0,INDEX(COUNTIF($E$1:E#,$A$2:$A$15),0,0),0)),"""")", "#", rng.Row()))
        If Cells(rng.Row(), "E").Value = "" Then Exit For
        Cells(rng.Row, "F").FormulaArray = Evaluate(Replace("SUM(IF($A$2:$A$15=E#, 1/(COUNTIFS($A$2:$A$15, E#, $B$2:$B$15, $B$2:$B$15)), 0))", "#", rng.Row()))
    Next rng
End Sub

这将结果显示在Column EF ，请参阅图像以供参考。

Answer 4

我会通过更简单的方法来解决这个问题。 没有任何代码示例。 只需考虑一下：

1. 遍历所有数据并根据两列查找唯一性-在这种情况下，您将仅获得2个结果。 每个新结果将保存到临时数组。

2. 再次循环遍历所有数据，并将每一行与存储的临时数组的每个字段进行比较。 为此添加计数器，仅此而已。

Answer 5

代码的效率在很大程度上取决于代码“命中”工作表的次数-对于您来说，在处理数据之前将数据读入数组会更快。 当涉及唯一计数时，应该想到字典。 假设您的数据在A到C列中，并在E列中输出...

Public Sub sub_UniqueCount()
    Dim wsThis As Worksheet: Set wsThis = ActiveSheet

    Dim vData As Variant
    Dim vOutput() As Variant
    Dim vKey

    Dim dicCount As Object: Set dicCount = CreateObject("scripting.dictionary")
    Dim dicTemp As Object

    Dim i As Long, j As Long

    Application.ScreenUpdating = False

    With wsThis
        ' load data into memory
        vData = .Range(.Range("A1").End(xlToRight), .Range("A1").End(xlDown))
        For i = LBound(vData, 1) + 1 To UBound(vData, 1)
            If dicCount.Exists(vData(i, 1)) Then
                dicCount(vData(i, 1))(vData(i, 2)) = dicCount(vData(i, 1))(vData(i, 2)) + 1
            Else
                Set dicTemp = CreateObject("scripting.dictionary")
                dicTemp(vData(i, 2)) = 1
                Set dicCount(vData(i, 1)) = dicTemp
            End If
        Next i

        ReDim vOutput(1 To dicCount.Count, 1 To 2)
        i = 1
        For Each vKey In dicCount.keys
            vOutput(i, 1) = vKey
            vOutput(i, 2) = dicCount(vKey).Count
            i = i + 1
        Next vKey

        .Range("E1").Resize(UBound(vOutput, 1) - LBound(vOutput, 1) + 1, UBound(vOutput, 2) - LBound(vOutput, 2) + 1) = vOutput

    End With

    Application.ScreenUpdating = True
End Sub