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

我会修电视

感觉不复杂，不知道理解的对不对。
=COUNTA(UNIQUE(A:A))-1
=ROWS(UNIQUE(A:B))-1

Benfyhu

ykcbf1100 发表于 2024-11-29 19:54
统计。。。

你好！YKCKF1100老师。还得麻烦您帮忙做下是事件类的。就是当输入日期后，自动自算的。非常感谢！我自个试图用您之前给出的方向改，无法成功！  还有一个，就是如果要计算同一个牌子，相对应的各种颜色在日期时间内的总和又是怎么做

ykcbf1100

Benfyhu 发表于 2024-12-2 11:29
你好！YKCKF1100老师。还得麻烦您帮忙做下是事件类的。就是当输入日期后，自动自算的。非常感谢！我自个 ...

你知道我回来了？我刚到家。

ykcbf1100

Benfyhu 发表于 2024-12-2 11:29
你好！YKCKF1100老师。还得麻烦您帮忙做下是事件类的。就是当输入日期后，自动自算的。非常感谢！我自个 ...

先不用工作表事件做一个吧

如果没有问题，可以再转成工作表事件

ykcbf1100

加个重量汇总

1. Sub ykcbf()   '//2024.12.2
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Set d1 = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("Sheet1 (2)")
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         arr = .[a1].Resize(r, 22)
   
7.     End With
   
8.     ReDim zrr(1 To r, 1 To 10)
   
9.     With Sheets("Sheet1")
   
10.         rq1 = .[b3].Value
    
11.         rq2 = .[e3].Value
    
12.         For i = 4 To UBound(arr)
    
13.             rq = CDate(arr(i, 10))
    
14.             If rq >= rq1 And rq <= rq2 Then
    
15.                 s = arr(i, 2)
    
16.                 d(s) = d(s) + 1
    
17.                 s = arr(i, 12)
    
18.                 If Not d1.exists(s) Then
    
19.                     m = m + 1
    
20.                     d1(s) = m
    
21.                     zrr(m, 1) = s
    
22.                     For j = 16 To UBound(arr, 2)
    
23.                         zrr(m, j - 14) = arr(i, j)
    
24.                     Next
    
25.                 Else
    
26.                     r = d1(s)
    
27.                     For j = 16 To UBound(arr, 2)
    
28.                         zrr(r, j - 14) = zrr(r, j - 14) + arr(i, j)
    
29.                     Next
    
30.                 End If
    
31.             End If
    
32.         Next
    
33.         .[g3] = d.Count & "个"
    
34.         d.RemoveAll
    
35.         For i = 4 To UBound(arr)
    
36.             rq = CDate(arr(i, 10))
    
37.             If rq >= rq1 And rq <= rq2 Then
    
38.                 s = arr(i, 2) & "-" & arr(i, 5)
    
39.                 If Not d.exists(s) Then
    
40.                     d(s) = arr(i, 4)
    
41.                 End If
    
42.             End If
    
43.         Next
    
44.         Sum = 0
    
45.         For Each k In d.keys
    
46.             Sum = Sum + d(k)
    
47.         Next
    
48.         .[h3] = Sum & "个"
    
49.         .[a5].Resize(1000, 9) = ""
    
50.         .[a5].Resize(m, 9) = zrr
    
51.         For i = 5 To m + 4
    
52.             .Cells(i, "i") = Application.Sum(.Cells(i, 2).Resize(, 7))
    
53.         Next
    
54.     End With
    
55.     Set d = Nothing
    
56.     MsgBox "OK！"
    
57. End Sub
    

复制代码

Benfyhu

ykcbf1100 发表于 2024-12-2 13:21
先不用工作表事件做一个吧

如果没有问题，可以再转成工作表事件

太棒了，要的就是这个效果。非常感谢！麻烦也转一个工作表事件。

ykcbf1100

工作表事件

ykcbf1100

工作表事件

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Application.EnableEvents = False
   
3.     If Target.Address = "$B$3" Or Target.Address = "$E$3" Then
   
4.         Set d = CreateObject("Scripting.Dictionary")
   
5.         Set d1 = CreateObject("Scripting.Dictionary")
   
6.         With Sheets("Sheet1 (2)")
   
7.             r = .Cells(Rows.Count, 1).End(3).Row
   
8.             arr = .[a1].Resize(r, 22)
   
9.         End With
   
10.         ReDim zrr(1 To r, 1 To 10)
    
11.         rq1 = Me.[b3].Value
    
12.         rq2 = Me.[e3].Value
    
13.         For i = 4 To UBound(arr)
    
14.             rq = CDate(arr(i, 10))
    
15.             If rq >= rq1 And rq <= rq2 Then
    
16.                 s = arr(i, 2)
    
17.                 d(s) = d(s) + 1
    
18.                 s = arr(i, 12)
    
19.                 If Not d1.exists(s) Then
    
20.                     m = m + 1
    
21.                     d1(s) = m
    
22.                     zrr(m, 1) = s
    
23.                     For j = 16 To UBound(arr, 2)
    
24.                         zrr(m, j - 14) = arr(i, j)
    
25.                     Next
    
26.                 Else
    
27.                     r = d1(s)
    
28.                     For j = 16 To UBound(arr, 2)
    
29.                         zrr(r, j - 14) = zrr(r, j - 14) + arr(i, j)
    
30.                     Next
    
31.                 End If
    
32.             End If
    
33.         Next
    
34.         Me.[g3] = d.Count & "个"
    
35.         d.RemoveAll
    
36.         For i = 4 To UBound(arr)
    
37.             rq = CDate(arr(i, 10))
    
38.             If rq >= rq1 And rq <= rq2 Then
    
39.                 s = arr(i, 2) & "-" & arr(i, 5)
    
40.                 If Not d.exists(s) Then
    
41.                     d(s) = arr(i, 4)
    
42.                 End If
    
43.             End If
    
44.         Next
    
45.         Sum = 0
    
46.         For Each k In d.keys
    
47.             Sum = Sum + d(k)
    
48.         Next
    
49.         If m > 0 Then
    
50.             Me.[h3] = Sum & "个"
    
51.             Me.[a5].Resize(1000, 9) = ""
    
52.             Me.[a5].Resize(m, 9) = zrr
    
53.             For i = 5 To m + 4
    
54.                 Me.Cells(i, "i") = Application.Sum(Me.Cells(i, 2).Resize(, 7))
    
55.             Next
    
56.         End If
    
57.         Set d = Nothing
    
58.     End If
    
59.     Application.EnableEvents = True
    
60. End Sub
    

复制代码

Benfyhu

ykcbf1100 发表于 2024-12-2 14:07
工作表事件

非常感谢！辛苦您了

Benfyhu

ykcbf1100 发表于 2024-12-2 13:21
先不用工作表事件做一个吧

如果没有问题，可以再转成工作表事件

还有一个小小的问题。就是当这个日期前没有数据时。运行时报这个错，可以优化吗？提示无数据，而不是报错