请教，多条件不重复计数

xiao99hui

如图所示，A2:A11区域中包含A或者B的并且不重复计数，怎么用函数决绝，请大神指教，谢谢

FOB_FN_L

Dim Myrow1%, Myrow2%, x%, y%, mycount%, Myr%, n%, m%
Dim Mycell1 As Range, Mycell2 As Range

Sub Bcfz()
'不重复值及个数代码

Myrow1 = Range("a2").CurrentRegion.Rows.Count
n = 2
For x = 2 To Myrow1 + 1
    Set Mycell1 = Cells(x, 1)
    For y = 2 To Myrow1 + 1
        Set Mycell2 = Cells(y, 1)
        If Cells(x, 1) = Cells(y, 1) Then
            mycount = mycount + 1
            If x = y And mycount = 1 Then
                Cells(n, 2) = Cells(x, 1)
            End If
        Else
        End If
    Next y
    If Cells(n, 2) <> "" Then
        Cells(n, 3).Value = mycount
        n = n + 1
    End If
200:    mycount = 0
Next x
Call Bcfzhs
End Sub
Sub Bcfzhs()
'不重复值所在的行数
     
    n = 2: m = 2
    Myrow1 = Range("a2").CurrentRegion.Rows.Count
    Myrow2 = Range("b2").End(xlDown).Row
    For x = 2 To Myrow2
        For y = 2 To Myrow1 + 1
            Cells(x, 2).Select
            Selection.Offset(1 - x, x) = Cells(x, 2)
            If Cells(x, 3) = 1 Then
                If Cells(x, 2) = Cells(y, 1) Then
                    Cells(m, n + x) = Cells(y, 1).Row
                    GoTo 200
                End If
            Else
                If Cells(x, 2) = Cells(y, 1) Then
                    Cells(m, n + x) = Cells(y, 1).Row
                    m = m + 1
                End If
            End If
        Next y
200:    n = 2: m = 2
    Next x
End Sub

蓝桥玄霜

店铺的例子：

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("sheet1")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a2:a" & r)
   
9.     For i = 1 To UBound(arr)
   
10.       xm = ""
    
11.       If InStr(arr(i, 1), "A") <> 0 Then
    
12.         xm = "A"
    
13.       ElseIf InStr(arr(i, 1), "B") <> 0 Then
    
14.         xm = "B"
    
15.       End If
    
16.       If xm <> "" Then
    
17.         If Not d.exists(xm) Then
    
18.           Set d(xm) = CreateObject("scripting.dictionary")
    
19.         End If
    
20.         d(xm)(arr(i, 1)) = ""
    
21.       End If
    
22.     Next
    
23.     m = 0
    
24.     For Each aa In d.keys
    
25.       m = m + 1
    
26.       .Cells(m, 4) = "店铺包含" & aa & "的不重复计数"
    
27.       .Cells(m, 5) = d(aa).Count
    
28.     Next
    
29.   End With
    
30. End Sub
    

复制代码

chxw68

使用字典反倒复杂了。

凌空一羽

Sub lkyy()
ar = Range("a1").CurrentRegion
MsgBox "现在计算带B的不重复店铺个数"
For i = 2 To UBound(ar)
    If InStr(ar(i, 1), "B") Then
        n = n + 1
        If n = 1 Then s = s & "," & ar(i, 1): b = 1
        If InStr(s & ",", "," & ar(i, 1) & ",") = 0 Then s = s & "," & ar(i, 1): b = b + 1
    End If
Next
MsgBox b
End Sub

micch

字典+filter就可以吧。既然说是用函数解决，就用countif或者match+count。好歹做个附件。  猜猜：  =count(1/(match(a2:a22,a:a,)=row(2:22))/find("B",a2:a22))

一把小刀闯天下

Option Explicit

Sub test()
  Dim rng As Range, dic(1), i
  For i = 0 To UBound(dic)
    Set dic(i) = CreateObject("scripting.dictionary")
  Next
  For Each rng In [a2:a11]
    If InStr(rng.Value, "A") Then dic(0)(rng.Value) = 1
    If InStr(rng.Value, "B") Then dic(1)(rng.Value) = 1
  Next
  Debug.Print "A:"; dic(0).Count, "B:"; dic(1).Count
End Sub

xiao99hui

micch 发表于 2020-2-25 12:03
字典+filter就可以吧。既然说是用函数解决，就用countif或者match+count。好歹做个附件。  猜猜：  =count( ...

谢谢，你公式可以用，就是意思有点不理解

xiao99hui

一把小刀闯天下 发表于 2020-2-25 13:16
Option Explicit

Sub test()

谢谢，不过我想要的是函数解决