重复数据只计算一次的问题

loirol

Benfyhu 发表于 2024-11-29 13:50
代码也可以的，麻烦老师了。

支持整列引用

ynzsvt

Benfyhu 发表于 2024-11-29 13:50
代码也可以的，麻烦老师了。

9楼的已经很好了。

Benfyhu

ykcbf1100 发表于 2024-11-29 13:57
上附件啊，统计个数更省力了。

麻烦您！YKCBF1100老师，非常感谢

ykcbf1100

Benfyhu 发表于 2024-11-29 15:23
麻烦您！YKCBF1100老师，非常感谢

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.11.29
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     r = Cells(Rows.Count, 1).End(3).Row
   
4.     arr = [a1].Resize(r, 3)
   
5.     rq1 = [e3].Value
   
6.     rq2 = [f3].Value
   
7.     ReDim brr(1 To r, 1 To 2)
   
8.     For i = 2 To UBound(arr)
   
9.         rq = CDate(arr(i, 1))
   
10.         If rq >= rq1 And rq <= rq2 Then
    
11.             s = arr(i, 2)
    
12.             d(s) = d(s) + 1
    
13.         End If
    
14.     Next
    
15.     [e5] = d.Count & "个"
    
16.     d.RemoveAll
    
17.     For i = 2 To UBound(arr)
    
18.         rq = CDate(arr(i, 1))
    
19.         If rq >= rq1 And rq <= rq2 Then
    
20.             s = arr(i, 2) & "-" & arr(i, 3)
    
21.             d(s) = d(s) + 1
    
22.         End If
    
23.     Next
    
24.     [f5] = d.Count & "个"
    
25.     Set d = Nothing
    
26.     MsgBox "OK！"
    
27. End Sub
    
28. 
    

复制代码

Benfyhu

ykcbf1100 发表于 2024-11-29 15:42
附件供参考。。。

我想让它日期输入后自动就计算了，不用按钮可以吗

ykcbf1100

Benfyhu 发表于 2024-11-29 15:46
我想让它日期输入后自动就计算了，不用按钮可以吗

那就工作表事件

ykcbf1100

工作表事件

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Application.EnableEvents = False
   
3.     If Target.Address = "$E$3" Or Target.Address = "$F$3" Then
   
4.         Set d = CreateObject("Scripting.Dictionary")
   
5.         r = Me.Cells(Rows.Count, 1).End(3).Row
   
6.         arr = Me.[a1].Resize(r, 3)
   
7.         rq1 = Me.[e3].Value
   
8.         rq2 = Me.[f3].Value
   
9.         ReDim brr(1 To r, 1 To 2)
   
10.         For i = 2 To UBound(arr)
    
11.             rq = CDate(arr(i, 1))
    
12.             If rq >= rq1 And rq <= rq2 Then
    
13.                 s = arr(i, 2)
    
14.                 d(s) = d(s) + 1
    
15.             End If
    
16.         Next
    
17.         Me.[e5] = d.Count & "个"
    
18.         d.RemoveAll
    
19.         For i = 2 To UBound(arr)
    
20.             rq = CDate(arr(i, 1))
    
21.             If rq >= rq1 And rq <= rq2 Then
    
22.                 s = arr(i, 2) & "-" & arr(i, 3)
    
23.                 d(s) = d(s) + 1
    
24.             End If
    
25.         Next
    
26.         Me.[f5] = d.Count & "个"
    
27.         Set d = Nothing
    
28.         MsgBox "OK！"
    
29.     End If
    
30.     Application.EnableEvents = True
    
31. End Sub
    
32. 
    

复制代码

Benfyhu

ykcbf1100 发表于 2024-11-29 15:51
那就工作表事件

太感谢了。这个代码通俗易懂。非常感谢

yanglinzi