根据A列中的条件计算B列中的唯一值

Question

我想根据A列中的条件对B列中的唯一值进行计数，这就是问题所在：

• 在A栏中，我们有月份数：

   A : 1 1 1 2 2 2 2 2 2 3 3 3 3 3 3 * 

• 在B列中，我们有汽车的序列号：

   B : H185 H185 S556 S556 s521 s521 f221 s521 d558 r5569 d558 d558 r555 r555 * 

我想知道每个月生产了多少辆汽车，并得到答复：

msgbox ( month 1 , 'NB produced car" , month 2," NB produced cars , ......) . 

Answer 1

在查询方面，您必须执行以下操作：

select count(B), A
 from tablename
group by A;

这将为您提供列表...然后在您的应用程序中使用它。

Answer 2

下面的方法使用Dictionary对象来保持几个月的时间并生产独特的汽车。 您可能需要修改代码以更正范围和消息。 让我们知道这是否适合您/是否需要更多帮助。

Sub CountUniqueByMonth()
    Dim rData As Range
    Dim oDictOuter As Object
    Dim rIterator As Range

    Set rData = Range("A2:A" & Range("A2").End(xlDown).Row)

    Set oDictOuter = CreateObject("Scripting.Dictionary")

    For Each rIterator In rData
        AddToDictIfNotExists oDictOuter, rIterator.Value, CreateObject("Scripting.Dictionary")
        AddToDictIfNotExists oDictOuter(rIterator.Value), rIterator.Offset(, 1).Value, ""
    Next rIterator


    For Each Key In oDictOuter.Keys
        MsgBox "Month: " & Key & " - " & oDictOuter(Key).Count & " produced car(s)"
    Next Key
End Sub

Private Sub AddToDictIfNotExists(oDict As Object, vKey As Variant, vValue As Variant)
    If Not oDict.exists(vKey) Then
        oDict.Add vKey, vValue
    End If
End Sub

Answer 3

你可以试试这个

Option Explicit

Sub main()
    Dim cell As Range
    Dim msg As String

    With Worksheets("Month-Cars").Range("A1:A" & Range("A2").End(xlDown).Row).SpecialCells(xlCellTypeConstants, xlNumbers) 'process only given sheet (change the name as per your needs) column "A" cells with numbers
        .Offset(, 2).FormulaR1C1 = "=COUNTIFS(RC1:R" & .Rows(.Rows.Count).Row & "C1,RC1,RC2:R" & .Rows(.Rows.Count).Row & "C2, RC2)" 'use "helper" cells in column "C" to localize unique pairs "month-serial number"
        With .Offset(, 3) 'use "helper" cells in column "D" to associate each month its unique pairs sum
            .FormulaR1C1 = "=COUNTIFS(" & .Offset(, -3).Address(, , xlR1C1) & ",RC1," & .Offset(, -1).Address(, , xlR1C1) & ",1)" 'calculate unique pairs sum
            .Value2 = .Value2 'get rid of formulas
        End With
        .Copy Destination:=.Offset(, 4) 'use "helper" cells in column "E" to duplicate "month" values and subsequent removing duplicates purposes
        .Offset(, 3).Resize(, 2).RemoveDuplicates Columns:=Array(2), Header:=xlNo ' remove months duplicate values

        For Each cell In .Offset(, 4).SpecialCells(xlCellTypeConstants, xlNumbers) 'loop through unique months to build the report message
            msg = msg & "month " & cell.Value2 & ": " & cell.Offset(, -1) & " produced car" & IIf(cell.Offset(, -1) > 1, "s", "") & vbCrLf
        Next cell

        .Offset(, 2).Resize(, 3).ClearContents 'clear all "helper" cells in columns "C", "D" ed "E"
    End With

    MsgBox msg 'prompt the report message

End Sub

它带有注释，以便您可以遵循代码并进行可能的更改