Excel精英培训网

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

[已解决]小弟走投无路请各位大神写一个vba代码

[复制链接]
发表于 2015-4-1 11:57 | 显示全部楼层 |阅读模式
本帖最后由 panda120 于 2015-4-2 14:17 编辑

vba代码计算重复数据,但是跟countif有所不同,例如在columnB一列相同的数据有5个,在5个相同数据columnD一列相同的数据有3个,在最后columnS一列,五行数据输出都是3,请问该怎么编写,谢谢各位大神!
最佳答案
2015-4-1 16:15
d列包含西文逗号","
  1. Sub Macro1()
  2. Dim arr, d, i&
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = Range("b1").CurrentRegion
  5. For i = 2 To UBound(arr)
  6.     If Not d.exists(arr(i, 1)) Then
  7.         d(arr(i, 1)) = arr(i, 3)
  8.     Else
  9.         If InStr("|" & d(arr(i, 1)) & "|", "|" & arr(i, 3) & "|") = 0 Then d(arr(i, 1)) = d(arr(i, 1)) & "|" & arr(i, 3)
  10.     End If
  11. Next
  12. a = d.keys
  13. For i = 0 To d.Count - 1
  14.     x = Split(d(a(i)), "|")
  15.     d(a(i)) = UBound(x) + 1
  16. Next
  17. For i = 2 To UBound(arr)
  18.     arr(i, 18) = d(arr(i, 1))
  19. Next
  20. Range("s1").Resize(UBound(arr)) = Application.Index(arr, 0, 18)
  21. End Sub
复制代码

运行宏之前数据

运行宏之前数据

运行宏之后数据

运行宏之后数据

工作簿1.rar

7.86 KB, 下载次数: 5

附件

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2015-4-1 12:40 | 显示全部楼层
  1. Sub Macro1()
  2. Dim arr, d, i&
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = Range("b1").CurrentRegion
  5. For i = 2 To UBound(arr)
  6.     If arr(i, 3) = "" Then arr(i, 3) = "@"
  7.     If Not d.exists(arr(i, 1)) Then
  8.         d(arr(i, 1)) = arr(i, 3)
  9.     Else
  10.         If InStr("," & d(arr(i, 1)) & ",", "," & arr(i, 3) & ",") = 0 Then d(arr(i, 1)) = d(arr(i, 1)) & "," & arr(i, 3)
  11.     End If
  12. Next
  13. a = d.keys
  14. For i = 0 To d.Count - 1
  15.     x = Split(d(a(i)), ",")
  16.     d(a(i)) = UBound(x) + 1
  17. Next
  18. For i = 2 To UBound(arr)
  19.     arr(i, 18) = d(arr(i, 1))
  20. Next
  21. Range("s1").Resize(UBound(arr)) = Application.Index(arr, 0, 18)
  22. End Sub
复制代码
回复

使用道具 举报

发表于 2015-4-1 13:39 | 显示全部楼层
dsmch 发表于 2015-4-1 12:40

大神,我关注你很长时间,也看了你的很多回复帖子,发现你很多问题都是用字典来解决的。我也看了别人的字典教程,可是到现在还是只会item用法,对于keys和exists总是不明白,能否开个帖子或是介绍一些教程?谢谢。

点评

都是些基础用法,看下基本教程结合具体例子,时间长了自然就会了  发表于 2015-4-1 14:45
回复

使用道具 举报

 楼主| 发表于 2015-4-1 13:55 | 显示全部楼层
dsmch 发表于 2015-4-1 12:40

大神,还是有的数据会返回错误,有的应该返回5的却返回6了,有解决办法么?

点评

用附件说明问题  发表于 2015-4-1 14:01
回复

使用道具 举报

 楼主| 发表于 2015-4-1 14:11 | 显示全部楼层
panda120 发表于 2015-4-1 13:55
大神,还是有的数据会返回错误,有的应该返回5的却返回6了,有解决办法么?

如图,数据应该返回5,现在却返回6
20150401140703.png

点评

上传excel文件  发表于 2015-4-1 14:46
回复

使用道具 举报

 楼主| 发表于 2015-4-1 15:25 | 显示全部楼层
dsmch 发表于 2015-4-1 12:40

大神,我抽了几组数据出错的,请帮忙看一下应该怎么改。谢谢

工作簿.rar

8.84 KB, 下载次数: 4

回复

使用道具 举报

发表于 2015-4-1 16:15 | 显示全部楼层    本楼为最佳答案   
d列包含西文逗号","
  1. Sub Macro1()
  2. Dim arr, d, i&
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = Range("b1").CurrentRegion
  5. For i = 2 To UBound(arr)
  6.     If Not d.exists(arr(i, 1)) Then
  7.         d(arr(i, 1)) = arr(i, 3)
  8.     Else
  9.         If InStr("|" & d(arr(i, 1)) & "|", "|" & arr(i, 3) & "|") = 0 Then d(arr(i, 1)) = d(arr(i, 1)) & "|" & arr(i, 3)
  10.     End If
  11. Next
  12. a = d.keys
  13. For i = 0 To d.Count - 1
  14.     x = Split(d(a(i)), "|")
  15.     d(a(i)) = UBound(x) + 1
  16. Next
  17. For i = 2 To UBound(arr)
  18.     arr(i, 18) = d(arr(i, 1))
  19. Next
  20. Range("s1").Resize(UBound(arr)) = Application.Index(arr, 0, 18)
  21. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2015-4-2 14:16 | 显示全部楼层
dsmch 发表于 2015-4-1 16:15
d列包含西文逗号","

完美解决谢谢
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-28 21:44 , Processed in 0.628711 second(s), 17 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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