Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2051|回复: 1

[已解决]用VBA数组或字典 进行多条件多列汇总

[复制链接]
发表于 2017-6-14 19:41 | 显示全部楼层 |阅读模式
本帖最后由 laoau138 于 2017-6-14 21:25 编辑

用VBA数组或字典  进行多条件多列汇总


最佳答案
2017-6-14 20:51
  1. Sub test()
  2.     Dim arr()
  3.     Dim x, y, k, m
  4.     Dim d
  5.     Set d = CreateObject("scripting.dictionary")
  6.     arr = Range("A1").CurrentRegion
  7.     ReDim brr(1 To UBound(arr), 1 To 4)
  8.     For x = 2 To UBound(arr)
  9.         If d.Exists(arr(x, 1) & arr(x, 2)) Then
  10.             m = d(arr(x, 1) & arr(x, 2))
  11.             brr(m, 3) = arr(x, 3) + brr(m, 3)
  12.             brr(m, 4) = arr(x, 4) + brr(m, 4)
  13.         Else
  14.             k = k + 1
  15.             d(arr(x, 1) & arr(x, 2)) = k
  16.             For y = 1 To 4
  17.                 brr(k, y) = arr(x, y)
  18.             Next y
  19.         End If
  20.     Next x
  21.     Range("g2").Resize(UBound(arr), 4) = brr
  22. End Sub
复制代码
用VBA数组或字典  进行多条件多列汇总.png

用VBA数组或字典 进行多条件多列汇总.rar

7.26 KB, 下载次数: 20

发表于 2017-6-14 20:51 | 显示全部楼层    本楼为最佳答案   
  1. Sub test()
  2.     Dim arr()
  3.     Dim x, y, k, m
  4.     Dim d
  5.     Set d = CreateObject("scripting.dictionary")
  6.     arr = Range("A1").CurrentRegion
  7.     ReDim brr(1 To UBound(arr), 1 To 4)
  8.     For x = 2 To UBound(arr)
  9.         If d.Exists(arr(x, 1) & arr(x, 2)) Then
  10.             m = d(arr(x, 1) & arr(x, 2))
  11.             brr(m, 3) = arr(x, 3) + brr(m, 3)
  12.             brr(m, 4) = arr(x, 4) + brr(m, 4)
  13.         Else
  14.             k = k + 1
  15.             d(arr(x, 1) & arr(x, 2)) = k
  16.             For y = 1 To 4
  17.                 brr(k, y) = arr(x, y)
  18.             Next y
  19.         End If
  20.     Next x
  21.     Range("g2").Resize(UBound(arr), 4) = brr
  22. End Sub
复制代码

评分

参与人数 1 +9 收起 理由
laoau138 + 9 来学习

查看全部评分

回复

使用道具 举报

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

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 03:34 , Processed in 0.519528 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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