尊敬的香川群子老师，您好！如何用VBA快速显示相同数的数量值，谢谢！

cartel

尊敬的香川群子老师，您好！如何用VBA快速显示相同数的数量值，谢谢！.zip (12.34 KB, 下载次数: 15)

2014-9-3 09:27 上传

点击文件名下载附件

sdong7

老师是日本人吗？？？

sdong7

楼主是搞彩票的？？

sdong7

1. Sub tt() 'by sdong720140903
   
2. Dim mxr1, mxr2 As Integer
   
3. Dim arr1, arr2, dic1, dic2, arr3, arr
   
4. mxr1 = Sheets("sheet1").[b1].End(xlDown).Row
   
5. mxr2 = Sheets("sheet1").[c1].End(xlDown).Row
   
6. ReDim arr3(1 To mxr2, 1 To 2)
   
7. arr1 = Sheets("sheet1").Range("b1:b" & mxr1)
   
8. arr2 = Sheets("sheet1").Range("c1:c" & mxr2)
   
9. Set dic1 = CreateObject("scripting.dictionary")
   
10.   Set dic2 = CreateObject("scripting.dictionary")
    
11. On Error Resume Next
    
12. For i = 1 To mxr1
    
13.   dic1.Add arr1(i, 1), ""
    
14. Next i
    
15. For i = 1 To mxr2
    
16. dic2(arr2(i, 1)) = dic2(arr2(i, 1)) + 1
    
17. Next i
    
18. For j = 1 To mxr2
    
19. If dic1.Exists(arr2(j, 1)) Then
    
20. arr = Split(arr2(j, 1), ",")
    
21. If UBound(arr) = 5 Then
    
22. arr3(j, 1) = dic2(arr2(j, 1))
    
23. arr3(j, 2) = 0
    
24. Else
    
25. arr3(j, 1) = 0
    
26. arr3(j, 2) = dic2(arr2(j, 1))
    
27. End If
    
28. Else
    
29. arr3(j, 1) = 0
    
30. arr3(j, 2) = 0
    
31. End If
    
32. Next j
    
33. Sheets("sheet1").Range("d1:e" & mxr2) = arr3
    
34. 
    
35. 
    
36. End Sub
    

复制代码

sdong7

我运行过了，可以的

sdong7

如果觉得好就送鲜花赞一下啦！

cartel

sdong7 发表于 2014-9-3 10:19
我运行过了，可以的

感谢您的回复！
我刚试了下，不同于我附件中的结果，我要的是同附件中的结果，希望再看下，先谢了！

香川群子

B列先进行组合、然后C列组合……逐行检查。

暂时就这样吧。

如果要提高效率，可以把C列各个行的组合结果先合并起来，然后再一起检查。

香川群子

经检查、B2取5组合时，C列取5符合的组合共有 6组，楼主说只有2组是错误的。
14,15,16,27,28
13,14,15,16,27
13,14,15,16,28
13,14,15,27,28
13,14,16,27,28
13,15,16,27,28

cartel

香川群子 发表于 2014-9-3 14:53
B列先进行组合、然后C列组合……逐行检查。

暂时就这样吧。

香川老师，您好!
由于我没有表达清楚，导致您的误解，
我要的结果是有多少行是有5个相同号码，有多少行是有6个相同号码，
意思是多少行就显示多少行的值，比如有2行是有5个相同号码，那就显示为‘2“
老师，真是不好意思，但又没办法自己解决问题，还是要请您帮忙看下。

下面我再上传附件，