我想根据A列中的条件计算B列中的唯一值,即问题:
我们有月份编号:
A : 1 1 1 2 2 2 2 2 2 3 3 3 3 3 3 *
我们有汽车的序列号:
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 , ......) .
答案 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
对其进行了评论,以便您可以按照代码进行更改