Excel精英培训网

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

[已解决]统计指定列相同的前提下,数据行出现的次数

[复制链接]
发表于 2016-1-5 12:04 | 显示全部楼层 |阅读模式
本帖最后由 jk0932 于 2016-1-5 14:06 编辑

如附件原始数据sheet所示,现在需要用VBA实现
统计CDEF列相同的数据行出现的次数,不管AB列是否相同均需要统计,
最终结果输出到结果示例;
最佳答案
2016-1-5 12:34
  1. Sub test()
  2. Dim arr, x As Integer, brr(1 To 10000, 1 To 5), z, zf, k, r
  3. Set z = CreateObject("scripting.dictionary")
  4. arr = Range("a1").CurrentRegion
  5. For x = 1 To UBound(arr)
  6.       zf = arr(x, 3) & arr(x, 4) & arr(x, 5) & arr(x, 6)
  7.       If z.exists(zf) Then
  8.              r = z(zf): brr(r, 5) = brr(r, 5) + 1
  9.        Else
  10.             k = k + 1
  11.             z(zf) = k
  12.             brr(k, 1) = arr(x, 3)
  13.             brr(k, 2) = arr(x, 4)
  14.             brr(k, 3) = arr(x, 5)
  15.             brr(k, 4) = arr(x, 6)
  16.             brr(k, 5) = 1
  17.        End If
  18. Next
  19. Sheets("结果示例").Select
  20. [a:e].Clear
  21. [a1].Resize(k, 5) = brr: [e1] = ""
  22. MsgBox "统计完毕"
  23. End Sub
复制代码

统计相同行出现的次数.rar

33.7 KB, 下载次数: 5

发表于 2016-1-5 12:34 | 显示全部楼层    本楼为最佳答案   
  1. Sub test()
  2. Dim arr, x As Integer, brr(1 To 10000, 1 To 5), z, zf, k, r
  3. Set z = CreateObject("scripting.dictionary")
  4. arr = Range("a1").CurrentRegion
  5. For x = 1 To UBound(arr)
  6.       zf = arr(x, 3) & arr(x, 4) & arr(x, 5) & arr(x, 6)
  7.       If z.exists(zf) Then
  8.              r = z(zf): brr(r, 5) = brr(r, 5) + 1
  9.        Else
  10.             k = k + 1
  11.             z(zf) = k
  12.             brr(k, 1) = arr(x, 3)
  13.             brr(k, 2) = arr(x, 4)
  14.             brr(k, 3) = arr(x, 5)
  15.             brr(k, 4) = arr(x, 6)
  16.             brr(k, 5) = 1
  17.        End If
  18. Next
  19. Sheets("结果示例").Select
  20. [a:e].Clear
  21. [a1].Resize(k, 5) = brr: [e1] = ""
  22. MsgBox "统计完毕"
  23. End Sub
复制代码
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 21:30 , Processed in 0.673839 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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