Excel精英培训网

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

[已解决]vba编码请各位大神帮忙

[复制链接]
发表于 2015-3-31 14:19 | 显示全部楼层 |阅读模式
请各位大神帮小弟一下,求助一个vba代码,在column A的号码相同,计算在column C里有几个name
非常感谢!!!
最佳答案
2015-4-1 12:38
  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
复制代码
1.png

运行宏之后

运行宏之后

Book1.rar

6.61 KB, 下载次数: 8

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2015-3-31 14:33 | 显示全部楼层
  1. Sub Macro1()
  2. Dim arr, d, i&
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = Range("a1").CurrentRegion
  5. For i = 2 To UBound(arr)
  6.     d(arr(i, 1)) = d(arr(i, 1)) + 1
  7. Next
  8. For i = 2 To UBound(arr)
  9.     arr(i, 4) = d(arr(i, 1))
  10. Next
  11. Range("d1").Resize(UBound(arr)) = Application.Index(arr, 0, 4)
  12. End Sub
复制代码
回复

使用道具 举报

发表于 2015-3-31 15:23 | 显示全部楼层
这个不用用到VBA,直接在C列输入公式=COUNTIF(A:A,A2)

Book1.rar

7.05 KB, 下载次数: 1

杀鸡不用牛刀

回复

使用道具 举报

 楼主| 发表于 2015-4-1 10:30 | 显示全部楼层
yuxirp 发表于 2015-3-31 15:23
这个不用用到VBA,直接在C列输入公式=COUNTIF(A:A,A2)

countif应该不是,比如某个号码有5行,后面name里面有3个不同的name,有两行是重复的,比如a,a,b,c,c,要输出数据就是3,用countif,b那行输出的数据就是5了
回复

使用道具 举报

发表于 2015-4-1 10:49 | 显示全部楼层
方法1,用宏
  1. Sub Macro1()
  2.     Dim arr, d, i&
  3.     Set d = CreateObject("scripting.dictionary")
  4.     arr = Range("a1").CurrentRegion
  5.     For i = 2 To UBound(arr)
  6.         d(arr(i, 1) & arr(i, 3)) = d(arr(i, 1) & arr(i, 3)) + 1
  7.     Next
  8.     For i = 2 To UBound(arr)
  9.         arr(i, 4) = d(arr(i, 1) & arr(i, 3))
  10.     Next
  11.     Range("d1").Resize(UBound(arr)) = Application.Index(arr, 0, 4)
  12. End Sub
复制代码
方法2:辅助列E列  E1=A1&C1,C1=COUNTIF(E:E,E2),下拉
回复

使用道具 举报

发表于 2015-4-1 10:52 | 显示全部楼层
不用辅助列,可用=COUNTIFS(A:A,A2,C:C,C2)。不过貌似C列为空的情况下结果是0。
回复

使用道具 举报

发表于 2015-4-1 10:53 | 显示全部楼层
=IF(COUNTIFS(A:A,A2,C:C,C2)=0,1,COUNTIFS(A:A,A2,C:C,C2))
回复

使用道具 举报

发表于 2015-4-1 10:54 | 显示全部楼层
panda120 发表于 2015-4-1 10:30
countif应该不是,比如某个号码有5行,后面name里面有3个不同的name,有两行是重复的,比如a,a,b,c,c ...

这样的话,代码代码改动如下

Book1.rar

12.67 KB, 下载次数: 8

回复

使用道具 举报

发表于 2015-4-1 11:00 | 显示全部楼层
上面的全错了,应该是这样。
  1. Sub Macro1()
  2.     Dim arr, d, i&
  3.     Set d = CreateObject("scripting.dictionary")
  4.     Set d1 = CreateObject("scripting.dictionary")
  5.     arr = Range("a1").CurrentRegion
  6.     For i = 2 To UBound(arr)
  7.         x = arr(i, 1) & arr(i, 3)
  8.         y = arr(i, 1)
  9.         If Not d.exists(x) Then
  10.             d1(y) = d1(y) + 1
  11.             d(x) = ""
  12.         End If
  13.     Next
  14.     For i = 2 To UBound(arr)
  15.         arr(i, 4) = d1(arr(i, 1))
  16.     Next
  17.     Range("d1").Resize(UBound(arr)) = Application.Index(arr, 0, 4)
  18. End Sub
复制代码

Book1.rar

15.52 KB, 下载次数: 3

回复

使用道具 举报

 楼主| 发表于 2015-4-1 11:13 | 显示全部楼层
本帖最后由 panda120 于 2015-4-1 11:14 编辑
dsmch 发表于 2015-4-1 10:54
这样的话,代码代码改动如下


非常感谢!就是这个样子的!不过我后来尝试在原有代码上改范围出错了,能再帮我下吗?我重新上传附件。非常感谢!!!

点评

附件呢?  发表于 2015-4-1 11:16
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 16:26 , Processed in 0.444432 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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