ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 362|回复: 13

[已解决] 条件字典数组求和后再汇总,难!咋实现???

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-10-18 10:37 | 显示全部楼层 |阅读模式
星期天了,打搅论坛里的老师休息,俺有个难题:想实现附件里的要求,恳请哪位帮忙,多谢!!!!!!!!!

字典数组去重求和汇总后再合计.rar

20.12 KB, 下载次数: 32

TA的精华主题

TA的得分主题

发表于 2020-10-18 10:51 | 显示全部楼层
字典(关键字)=字典(关键字)+数据
就是去重汇总了

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-10-18 10:54 | 显示全部楼层
尊敬的microyip老师:俺就卡在这里了,劳烦帮弄弄??谢谢!!!

TA的精华主题

TA的得分主题

发表于 2020-10-18 11:20 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-10-18 11:23 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-10-18 11:34 | 显示全部楼层
Sub 求和()
    Set d = CreateObject("scripting.dictionary")
    arr = Range("A1").CurrentRegion
    ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) + 1)
    k = 1
    For i = 2 To UBound(arr)
        If Trim(arr(i, 1)) <> "" Then
            t = d(Trim(arr(i, 1)))
            If t = "" Then
                k = k + 1
                d(Trim(arr(i, 1))) = k
                t = k
                brr(k, 1) = arr(i, 1)
            End If
            For j = 2 To UBound(arr, 2)
                brr(t, j) = brr(t, j) + arr(i, j)
                brr(t, UBound(brr, 2)) = brr(t, UBound(brr, 2)) + arr(i, j)
            Next j
        End If
    Next i
    For j = 2 To UBound(brr, 2)
        brr(k + 1, j) = Application.Sum(Application.Index(brr, 0, j))
    Next j
    For j = 1 To UBound(arr, 2)
        brr(1, j) = arr(1, j)
    Next j
    brr(k + 1, 1) = "合计"
    brr(1, UBound(brr, 2)) = "合计"
    Range("K1:IV65536").ClearContents
    With Range("K1")
        .Resize(k + 1, UBound(brr, 2)) = brr
    End With
    Set d = Nothing
End Sub

评分

参与人数 1鲜花 +2 收起 理由
wowo000 + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-10-18 11:36 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-10-18 11:53 | 显示全部楼层
练习练习
  1. Sub 汇总()
  2. Set d = CreateObject("scripting.dictionary")
  3.     With Sheets("单条件")
  4.         r = .Range("a65536").End(xlUp).Row
  5.         arr = .Range("a2:i" & r)
  6.         ReDim brr(1 To UBound(arr), 1 To 10)
  7.         For i = 1 To UBound(arr)
  8.             If arr(i, 1) = "" Then Exit For
  9.             s = arr(i, 1)
  10.             If Not d.exists(s) Then d(s) = d.Count + 1
  11.             brr(d(s), 1) = s
  12.             For j = 2 To UBound(arr, 2)
  13.                 brr(d(s), j) = brr(d(s), j) + arr(i, j)
  14.             Next j
  15.         Next i
  16.         For i = 1 To d.Count
  17.             For j = 2 To UBound(brr, 2) - 1
  18.                 brr(i, UBound(brr, 2)) = brr(i, UBound(brr, 2)) + brr(i, j)
  19.                 brr(d.Count + 1, j) = brr(d.Count + 1, j) + brr(i, j)
  20.             Next j
  21.                 brr(d.Count + 1, 10) = brr(d.Count + 1, 10) + brr(i, 10)
  22.         Next i
  23.         .Range("k2").Resize(d.Count + 1, 10) = brr
  24.     End With
  25. End Sub
复制代码

评分

参与人数 1鲜花 +2 收起 理由
wowo000 + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-10-18 11:54 | 显示全部楼层
>>>>>>>>>>

1_单条件多列汇总.rar

33.72 KB, 下载次数: 9

TA的精华主题

TA的得分主题

发表于 2020-10-18 11:54 | 显示全部楼层
  1. Sub ba() 'by bajifeng | QQ:249346223
  2. Dim br(1 To 10000, 1 To 10)
  3. Set d = CreateObject("Scripting.Dictionary")
  4. ar = Range("a1:i" & [a65536].End(3).Row)
  5. For i = 2 To UBound(ar)
  6.     If Len(ar(i, 1)) And Not d.exists(ar(i, 1)) Then
  7.         n = n + 1
  8.         d(ar(i, 1)) = n
  9.         For j = 1 To 9
  10.             br(n, j) = ar(i, j)
  11.         Next
  12.     Else
  13.         For j = 2 To 9
  14.             ib = d(ar(i, 1))
  15.             br(ib, j) = br(ib, j) + ar(i, j)
  16.         Next
  17.     End If
  18. Next
  19. For i = 1 To n
  20.     s = 0
  21.     For j = 2 To 9
  22.         s = s + br(i, j)
  23.     Next
  24.     br(i, 10) = s
  25. Next
  26. For j = 2 To 10
  27.     s = 0
  28.     For i = 1 To n
  29.         s = s + br(i, j)
  30.     Next
  31.     br(n + 1, j) = s
  32. Next
  33. [t1] = "合计"
  34. br(n + 1, 1) = [t1]
  35. [k2].Resize(999, 10).Clear
  36. [k2].Resize(n + 1, 10) = br
  37. End Sub
复制代码

评分

参与人数 1鲜花 +2 收起 理由
wowo000 + 2 感谢帮助

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,高效办公专列,每天发车

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

GMT+8, 2020-10-29 01:17 , Processed in 0.080440 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2021 Wooffice Inc.

   

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

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

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