根据查询条件，统计不重复值的和

8525855

由于数据比较大，用公式的话，应该要涉及到数组，所以会比较慢，比较卡。
VBA如何处理？或者通过VBA自定义公式最好。

按条件统计不重复值求和.rar (7.63 KB, 下载次数: 18)

2024-6-10 20:11 上传

点击文件名下载附件

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.6.10
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     r = Cells(Rows.Count, 1).End(3).Row
   
5.     arr = [a1].Resize(r, 3)
   
6.     For i = 2 To UBound(arr)
   
7.         s = arr(i, 1): ss = arr(i, 2)
   
8.         If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
   
9.         If Not d(s).exists(ss) Then
   
10.             d(s)(ss) = arr(i, 3)
    
11.         End If
    
12.     Next
    
13.     ReDim brr(1 To d.Count, 1 To 2)
    
14.     For Each k In d.keys
    
15.         m = m + 1
    
16.         brr(m, 1) = k
    
17.         brr(m, 2) = Application.Sum(d(k).items)
    
18.     Next
    
19.     [e2:f9] = ""
    
20.     [e2].Resize(m, 2) = brr
    
21.     [e2].Resize(m, 2).Borders.LineStyle = 1
    
22.     Set d = Nothing
    
23.     Application.ScreenUpdating = True
    
24.     MsgBox "OK！"
    
25. End Sub
    

复制代码

shiruiqiang

Qs18

Sub test()
Dim arr, dic As Object, i, j, brr
arr = Sheet1.Range("a1").CurrentRegion.Value
Set dic = CreateObject("scripting.dictionary")
Set dic2 = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
    s = VBA.Join(Array(arr(i, 1), arr(i, 2)))
    If Not dic.exists(s) Then
        dic(s) = arr(i, 3)
    Else
    End If
Next
For Each k In dic.keys
    br = Split(k)
    s1 = br(0)
    If Not dic2.exists(s1) Then
        dic2(s1) = dic(k)
    Else
        dic2(s1) = dic2(s1) + dic(k)
    End If
Next
Sheet1.Range("f2").Value = dic2(Sheet1.Range("e2").Value)
Sheet1.Range("f3").Value = dic2(Sheet1.Range("e3").Value)
End Sub

明天会更好zj

Qs18

试一下.....

pdadet

十几年没有来了，类似的基本全关了，再来学习一下

longwin

参与一下：
Sub test()
With ActiveSheet
    arr = .[a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    Set d1 = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        s = arr(i, 1) & "|" & arr(i, 2)
        If Not d.exists(s) Then
            d(s) = arr(i, 3)
            d1(arr(i, 1)) = d1(arr(i, 1)) + arr(i, 3)
        End If
    Next
    For i = 2 To [E1].End(4).Row
    .Cells(i, 6) = d1(.Cells(i, 5).Value)
    Next
End With
set d1 = nothing
set d = nothing
End Sub

cnmlgb9998

真的不是不尊重大家。看了大家写的代码，我真的想笑。


借楼练一下PQ。看我几行代码？大家几行代码？

PQ 难道就真的不香么？？？？？？？？？？

为什么PQ区 冷冷的？