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

时间:2016-04-26 13:08:35

标签: vba excel-vba excel

我想根据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 , ......) . 

3 个答案:

答案 0 :(得分:0)

查询方面,您必须执行以下操作:

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

这会让你获得列表...然后在你的应用程序中使用它。

答案 1 :(得分:0)

以下方法使用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

答案 2 :(得分:0)

你可以试试这个

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

对其进行了评论,以便您可以按照代码进行更改