多条件统计

金樽邀月

        各位老师，我想在“汇总”工作表中统计各位主管分管的车间数量,VBA还不太熟悉，向老师们请教。

良良

B2=SUMPRODUCT((明细!$C$2:$C$22=$A2)/COUNTIFS(明细!A$2:A$22,明细!A$2:A$22,明细!$C$2:$C$22,明细!$C$2:$C$22))，右拉、下拉。

沈默00

标准的字典写法，，，给点小建议呀
1 不要用工作表函数了，利用字典的计数功能
2 不要用单元格代码，，改用数组，，，
具体的可以多看看别人的贴，，，多写几遍加深印象

ykcbf1100

参与一下，2级字典，看着简单，写起来却有点费劲。

ykcbf1100

参与一下，其实公式更简单。

1. Sub ykcbf()   '//2024.8.5
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("明细")
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         arr = .[a1].Resize(r, 3)
   
7.     End With
   
8.     ReDim brr(1 To r, 1 To 3)
   
9.     For i = 2 To UBound(arr)
   
10.         s = arr(i, 3): ss = arr(i, 1)
    
11.         If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
    
12.         d(s)(ss) = ""
    
13.     Next
    
14.     For Each k In d.keys
    
15.         m = m + 1
    
16.         brr(m, 1) = k
    
17.         brr(m, 2) = d(k).Count
    
18.         n = 0
    
19.         For i = 2 To UBound(arr)
    
20.             If arr(i, 3) = k Then
    
21.                 n = n + 1
    
22.             End If
    
23.         Next
    
24.         brr(m, 3) = n
    
25.     Next
    
26.     With Sheets("汇总")
    
27.         .[a2:c1000] = ""
    
28.         .[a2].Resize(m, 3) = brr
    
29.     End With
    
30.     Set d = Nothing
    
31.     Application.ScreenUpdating = True
    
32.     MsgBox "OK！"
    
33. End Sub
    

复制代码

金樽邀月

ykcbf1100 发表于 2024-8-5 21:17
参与一下，其实公式更简单。

谢谢老师的热心解答。

金樽邀月

良良 发表于 2024-8-5 17:14
B2=SUMPRODUCT((明细!$C$2:$C$22=$A2)/COUNTIFS(明细!A$2:A$22,明细!A$2:A$22,明细!$C$2:$C$22,明细!$C$2:$ ...

测试了一下，用函数确实可以解决问题。谢谢！

7993708

用数据透视表2分钟可以

Qs18

Sub qs()
Dim arr, i, dic
Set dic = CreateObject("scripting.dictionary")
arr = Sheet1.Range("a1").CurrentRegion.Value
ReDim brr(1 To UBound(arr), 1 To 3)
For i = 2 To UBound(arr)
    s = arr(i, 3)
    If Not dic.exists(s) Then
        m = m + 1
        dic(s) = m
        brr(m, 1) = s
        brr(m, 2) = arr(i, 1)
        brr(m, 3) = 1
    Else
        rw = dic(s)
        brr(rw, 3) = brr(rw, 3) + 1
        If VBA.InStr(brr(rw, 2), arr(i, 1)) = 0 Then
        brr(rw, 2) = brr(rw, 2) & "|" & arr(i, 1)
        End If
    End If
Next
For i = 1 To m
    brr(i, 2) = UBound(Split(brr(i, 2), "|")) + 1
Next
Sheet2.Range("a2").Resize(m, 3) = brr
End Sub

Qs18

试试..........