春节期间 给员工的福利

美团王超

123-456789 发表于 2022-1-22 13:44
PQ完成的

完犊子了   根本看不懂  

kuangben8

1. Sub 非重复汇总()
   
2.     Dim dic As Object
   
3.     Dim arr, m&, brr, crr()
   
4.     Set dic = CreateObject("Scripting.Dictionary")
   
5.     arr = Range("A1").CurrentRegion
   
6.     brr = Range("E1:H1")
   
7.     For m = 2 To UBound(arr, 1)
   
8.         If IsNumeric(arr(m, 3)) Then
   
9.             If arr(m, 3) >= brr(1, 2) And arr(m, 3) <= brr(1, 4) Then
   
10.                 If Not dic.Exists(arr(m, 1)) Then
    
11.                     Set dic(arr(m, 1)) = CreateObject("Scripting.Dictionary")
    
12.                 End If
    
13.                 dic(arr(m, 1))(arr(m, 2)) = ""
    
14.             End If
    
15.         End If
    
16.     Next
    
17.     ReDim crr(1 To dic.Count + 2, 1 To 2)
    
18.     crr(1, 1) = "城市": crr(1, 2) = "在岗人数": crr(dic.Count + 2, 1) = "总计"
    
19.     For m = 2 To UBound(crr, 1) - 1
    
20.         crr(m, 1) = dic.keys()(m - 2)
    
21.         crr(m, 2) = dic(dic.keys()(m - 2)).Count
    
22.         crr(dic.Count + 2, 2) = crr(dic.Count + 2, 2) + crr(m, 2)
    
23.     Next
    
24.     Range("E2:F2000").ClearContents
    
25.     Range("E2").Resize(UBound(crr, 1), 2) = crr
    
26. End Sub
    

复制代码

kuangben8

求助热线.zip (1.79 MB, 下载次数: 5)

2022-1-22 20:03 上传

点击文件名下载附件

美团王超

kuangben8 发表于 2022-1-22 19:36

我是个 表格小白  太高深了   谢谢大哥

sobili

美团王超 发表于 2022-1-22 12:37
名字重复的算一次， 谢谢大哥

改了一下，看下可以吗？ 求助热线.rar (1.22 MB, 下载次数: 8)

2022-1-24 11:16 上传

点击文件名下载附件

美团王超

sobili 发表于 2022-1-24 11:16
改了一下，看下可以吗？

有没有 什么函数 可以表达得     我这个看不懂，谢谢大哥

sobili

美团王超 发表于 2022-1-25 14:32
有没有 什么函数 可以表达得     我这个看不懂，谢谢大哥

我用数据透视表做的。函数不会。而且，你的表格有1MB大小。用函数的话，估计会很卡。