根據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

它帶有注釋，以便您可以遵循代碼並進行可能的更改