Excel精英培训网

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

[已解决]不重复计数问题求助

[复制链接]
发表于 2014-4-12 20:29 | 显示全部楼层 |阅读模式
请大侠帮忙,希望用VBA代码来完成,条件统计不重复的个数。
VBA方法统计不重复的个数.rar (50.12 KB, 下载次数: 7)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2014-4-12 20:50 | 显示全部楼层
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. If Target.Address = "$B$4" Then
  3.     x = Target.Value
  4.     Dim arr, d, d2, i&
  5.     Set d = CreateObject("scripting.dictionary")
  6.     Set d2 = CreateObject("scripting.dictionary")
  7.     arr = Sheets("数据").UsedRange
  8.     For i = 4 To UBound(arr)
  9.         If arr(i, 9) = "改造" And arr(i, 1) <= x Then
  10.             If Not d.exists(arr(i, 2)) Then d(arr(i, 2)) = d(arr(i, 2)) + 1
  11.         End If
  12.         If arr(i, 1) <= x And Not d2.exists(arr(i, 2)) Then d2(arr(i, 2)) = d2(arr(i, 2)) + 1
  13.     Next
  14.     [c2] = d.Count
  15.     [c4] = d2.Count
  16. End If
  17. End Sub
复制代码
回复

使用道具 举报

发表于 2014-4-12 20:52 | 显示全部楼层    本楼为最佳答案   
改变下拉框内容,自动产生结果

VBA方法统计不重复的个数.zip

288.45 KB, 下载次数: 16

回复

使用道具 举报

 楼主| 发表于 2014-4-13 07:44 | 显示全部楼层
dsmch 发表于 2014-4-12 20:52
改变下拉框内容,自动产生结果

非常感谢
不过,结果有点问题,1号的结果应该是2,可是统计的结果是3呀。即使删除1号的,还会统计1个。
回复

使用道具 举报

发表于 2014-4-13 08:53 | 显示全部楼层
………………

VBA方法统计不重复的个数.zip

288.53 KB, 下载次数: 1

评分

参与人数 1 +1 收起 理由
hgdzhh + 1 赞一个!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2014-4-13 09:33 | 显示全部楼层
本帖最后由 hgdzhh 于 2014-4-13 09:36 编辑
dsmch 发表于 2014-4-13 08:53
………………


很好,非常感谢,想多给分,为什么不能呢?
回复

使用道具 举报

 楼主| 发表于 2014-4-15 17:21 | 显示全部楼层
本帖最后由 hgdzhh 于 2014-4-15 17:39 编辑
dsmch 发表于 2014-4-13 08:53
………………


由于考虑不周,现在有个问题,就是空的单元格不统计,希望再次帮忙。
VBA方法统计不重复的个数.rar (49.67 KB, 下载次数: 2)
回复

使用道具 举报

发表于 2014-4-15 17:52 | 显示全部楼层
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$4" Then
    x = Target.Value
    Dim arr, d, d2, i&
    Set d = CreateObject("scripting.dictionary")
    Set d2 = CreateObject("scripting.dictionary")
    arr = Sheets("数据").UsedRange
    For i = 4 To UBound(arr)
        If arr(i, 1) = "" Then Exit For
        If arr(i, 9) = "改造" And arr(i, 1) <= x And arr(i, 2) <> "" Then
            d(x & "," & arr(i, 2) & "," & arr(i, 9)) = ""
        End If
        If arr(i, 1) <= x And arr(i, 2) <> "" Then d2(x & "," & arr(i, 2)) = ""
    Next
    [c2] = d.Count
    [c4] = d2.Count
End If
End Sub
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 02:16 , Processed in 0.684963 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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