计数唯一值基于列准则

我想指望基于列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 , ......) .

来源

2016-04-26 H.hisoka

查询明智的，你必须做到以下几点：

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

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

来源

2016-04-26 13:16:18

我需要一个布顿，宏..... –

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

来源

2016-04-26 13:42:03 user3561813

你可以试试这个

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

它的评论，这样就可以按照代码，使可能发生的变化

来源

2016-04-26 15:17:58 user3598756

计数唯一值基于列准则

回答

相关问题