问根据另一列中给出的标准计算唯一值
EN

Stack Overflow用户

提问于 2017-07-04 05:49:33

回答 5查看 1.2K关注 0票数 0

我有一份机器清单，列出了正在生产的各个批次和零件号。

我需要机器中运行的批次的唯一计数。这个长长的列表每天都会更新。我在这里附上了一个例子。

我有这个粗略的代码。

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

这在十进制数字中产生了不想要的结果。

excel

vba

回答 5

Stack Overflow用户

发布于 2017-07-04 07:27:33

假设: a。A列中的数据。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

票数 0

Stack Overflow用户

发布于 2017-07-04 08:06:43

也不是最干净的，但你可以完全避免循环，在使用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

票数 0

Stack Overflow用户

发布于 2017-07-04 09:15:48

另一种解决方案：

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