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 湾数据表中唯一使用的范围是列A：C C。结果将打印在范围内（＆＃34; E1＆＃34;）

在您期望大量数据的情况下，使用词典可能是删除重复项的最有效方法之一。如果这有帮助，请告诉我。

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

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

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 E-F中显示结果，请参阅图片以供参考。

Answer 4

我会以更简单的方式接近这一点。没有任何代码示例。试想一下：

循环浏览所有数据并根据两列查找唯一身份 - 在这种情况下，您只会得到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

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

5 个答案: