[英]count unique Values in column B based on criteria in column A
I want to count unique values in column B based on criteria in column A, that is the problem: 我想根据A列中的条件对B列中的唯一值进行计数,这就是问题所在:
in column A we have the months number: 在A栏中,我们有月份数:
A : 1 1 1 2 2 2 2 2 2 3 3 3 3 3 3 *
in column B we have the serial number of the cars: 在B列中,我们有汽车的序列号:
B : H185 H185 S556 S556 s521 s521 f221 s521 d558 r5569 d558 d558 r555 r555 *
I want to know how many cars were produced in each month, and get a response: 我想知道每个月生产了多少辆汽车,并得到答复:
msgbox ( month 1 , 'NB produced car" , month 2," NB produced cars , ......) .
Query-wise you have to do the following: 在查询方面,您必须执行以下操作:
select count(B), A
from tablename
group by A;
This gets you the list... then use it in your application. 这将为您提供列表...然后在您的应用程序中使用它。
The following approach uses Dictionary
objects to keep a tally of months and unique cars produced. 下面的方法使用
Dictionary
对象来保持几个月的时间并生产独特的汽车。 You may have to amend the code to correct for ranges and messages. 您可能需要修改代码以更正范围和消息。 Let us know if this works for you / if you need more help.
让我们知道这是否适合您/是否需要更多帮助。
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
you can try this 你可以试试这个
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
it's commented so that you can follow the code and make possible changes 它带有注释,以便您可以遵循代码并进行可能的更改
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.