ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 266|回复: 14

[求助] 根据查询条件,统计不重复值的和

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-6-10 20:11 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
图片.png

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

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

TA的精华主题

TA的得分主题

发表于 2024-6-10 20:36 | 显示全部楼层
本帖最后由 ykcbf1100 于 2024-6-10 20:50 编辑

附件供参考。。。

按条件统计不重复值求和.zip

16.73 KB, 下载次数: 17

评分

3

查看全部评分

TA的精华主题

TA的得分主题

发表于 2024-6-10 20:37 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 ykcbf1100 于 2024-6-10 20:49 编辑

参与一下。。。
  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
复制代码

评分

3

查看全部评分

TA的精华主题

TA的得分主题

发表于 2024-6-10 20:37 | 显示全部楼层
本帖最后由 shiruiqiang 于 2024-6-10 20:38 编辑

image.jpg

按条件统计不重复值求和.rar

14.13 KB, 下载次数: 8

评分

3

查看全部评分

TA的精华主题

TA的得分主题

发表于 2024-6-10 21:06 | 显示全部楼层
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

TA的精华主题

TA的得分主题

发表于 2024-6-10 21:08 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2024-6-10 21:09 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
试一下.....

按条件统计不重复值求和.rar

17 KB, 下载次数: 5

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2024-6-10 21:18 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2024-6-10 21:43 | 显示全部楼层
参与一下:
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

按条件统计不重复值求和.zip

15.84 KB, 下载次数: 5

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2024-6-10 21:58 | 显示全部楼层
本帖最后由 cnmlgb9998 于 2024-6-10 21:59 编辑

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


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

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

为什么PQ区 冷冷的?
捕获.PNG
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-6-16 04:05 , Processed in 1.053158 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表