同一天同一人只能统计1天

陈功

问题：同一天同一人只能统计1天,我代码统计全部。例：

唐一九、唐二九、唐三九、唐五九、罗一一

唐一九、马一华、唐三九、罗一一、章一林

5月9日，唐一九、唐三九、罗一一，三人只能统计出勤天数1天，我统计是2天多1天
    我代码是网上例子改的，请大家帮助，谢谢！

陈功

请大家帮助，谢谢！

liulang0808

1. Option Explicit
   
2. 
   
3. 
   
4. 
   
5. 
   
6. 
   
7.         
   
8. Sub 汇总()
   
9.     Const 标准 = 30 '补贴标准
   
10.     Dim d As Object, dd, dt, arr, a(), n, i%, R%, C%, k
    
11.     arr = Sheet1.Range("a1").CurrentRegion
    
12.     Set d = CreateObject("Scripting.Dictionary")
    
13.     Set dd = CreateObject("Scripting.Dictionary")
    
14.     Set dt = CreateObject("Scripting.Dictionary")
    
15.     For i = 2 To UBound(arr)
    
16.         dt(arr(i, 2)) = dt(arr(i, 2)) & "、" & arr(i, 4)
    
17.     Next
    
18.    
    
19.     For i = 0 To dt.Count - 1
    
20.         C = Month(dt.keys()(i))
    
21.         dd.RemoveAll
    
22.         For Each k In Split(Mid(dt.items()(i), 2), "、")
    
23.             dd(k) = k
    
24.         Next
    
25.         
    
26.         For Each k In dd.keys
    
27.             If Not d.Exists(k) Then
    
28.                 n = n + 1: d(k) = n
    
29.                 ReDim Preserve a(1 To 12, 1 To n)
    
30.                 a(C, n) = 1
    
31.             Else
    
32.                 R = d.Item(k)
    
33.                 a(C, R) = a(C, R) + 1
    
34.             End If
    
35.         Next
    
36.     Next
    
37.     Sheet3.Select
    
38.     Application.ScreenUpdating = False
    
39.     With Range("A4:p10000")
    
40.         .ClearContents
    
41.         .Borders.LineStyle = xlNone
    
42.     End With
    
43.     Range("A4").Resize(d.Count, 1) = WorksheetFunction.Transpose(d.keys)
    
44.     Range("B4").Resize(d.Count, 12) = WorksheetFunction.Transpose(a)
    
45.     Range("N4").Resize(d.Count, 1).FormulaR1C1 = "=SUM(RC2:RC13)"
    
46.     Range("O4").Resize(d.Count, 1).FormulaR1C1 = "=RC14*" & 标准
    
47.     With Range("A4").Offset(d.Count, 0)
    
48.         .Value = "合计"
    
49.         .Offset(0, 1).Resize(1, 14).FormulaR1C1 = "=SUM(R2C:R" & d.Count + 3 & "C)"
    
50.     End With
    
51.     Range("A3").CurrentRegion.Borders.LineStyle = xlContinuous
    
52.     Application.ScreenUpdating = True
    
53. End Sub

复制代码

liulang0808

附件供参考。。。。。。

不知道为什么

陈功 发表于 2018-8-5 20:10
请大家帮助，谢谢！

你模拟的结果中，唐三九 5月的次数正确么？为什么我代码出来是7 你是9？

不知道为什么

陈功 发表于 2018-8-5 20:10
请大家帮助，谢谢！

如图

不知道为什么

陈功 发表于 2018-8-5 20:10
请大家帮助，谢谢！

参考

陈功

不知道为什么 发表于 2018-8-5 20:45
你模拟的结果中，唐三九 5月的次数正确么？为什么我代码出来是7 你是9？

是我错了，谢谢热心帮助！

jiminyanyan

不知道为什么 发表于 2018-8-5 20:49
参考

字典套字典，用的还不错。。。

不知道为什么

jiminyanyan 发表于 2018-8-5 21:01
字典套字典，用的还不错。。。

呵呵 谢谢jimin老师鼓励