统计组合(重复)次数

yyhhhbb

某区域同行都有3个个位数字，将其两两组合后，统计整个区域各组合出现次数。
统计组合次数.rar (10.67 KB, 下载次数: 77)

2011-4-30 17:46 上传

点击文件名下载附件

（用函数无法直接得到，只有求助VBA解决）

谢谢先！

angellbxsc

此题不错，谢谢提供！
函数可以做到
请见附件参考表！
公式修改下（原公式调整了第二参数后，不必加substitute函数了）
TEXT(SMALL(IF(FREQUENCY(SMALL(MMULT(--RIGHT(SMALL($B$3:$D$20+ROW($1:$18)*100,COLUMN($A:$C)+3*(ROW($1:$18)-1))),{10,10,0;1,0,10;0,1,1}),ROW($1:$54)),ROW($1:$98))=$A28,ROW($1:$99),4^8),COLUMN(A1)),"[>100]! ;[<100]00;;")

[ 本帖最后由 angellbxsc 于 2011-5-1 01:22 编辑 ]

yyhhhbb

真是佩服至致I
天外天,人外人!!!
没想到现在函数运用这么好,开眼了!

谢谢angellbxsc 先生!

angellbxsc

呵呵，言过了！
只是我不会VBA，这方面帮不了你！
以后如学习的话，还要多讨教！

yyhhhbb

见识angellbxsc 先生的精妙公式，也很想见识一下迅捷VB方法。
不知路过的高手可否出招。

yyhhhbb

精益求精!
再次感谢!

yyhhhbb

这是我在网上搜得的一段程序代码，几经改动也无法得到一楼全部诉求。
（只是可以得到数据结果，但无法将数据按要求排列）
排置统计结果.rar (19.76 KB, 下载次数: 31)

2011-5-1 10:33 上传

点击文件名下载附件

希望能有幸得到高人惠顾指点！

[ 本帖最后由 yyhhhbb 于 2011-5-1 10:43 编辑 ]

蓝桥玄霜

1. Sub yy()
   
2. Dim Arr, i&, Brr, Arr1, aa
   
3. Dim d, k, t, Crr(1 To 4)
   
4. Arr = [c4].CurrentRegion
   
5. [o4:ca7].ClearContents
   
6. ReDim Brr(1 To UBound(Arr), 1 To 3)
   
7. For i = 1 To UBound(Arr)
   
8.     mx = Application.Max(Application.Index(Arr, i, 0))
   
9.     mn = Application.Small(Application.Index(Arr, i, 0), 1)
   
10.     de = Application.Small(Application.Index(Arr, i, 0), 2)
    
11.     Brr(i, 1) = Format(mn & de, "00")
    
12.     Brr(i, 2) = Format(mn & mx, "00")
    
13.     Brr(i, 3) = Format(de & mx, "00")
    
14. Next
    
15. Set d = CreateObject("Scripting.Dictionary")
    
16. For Each ar In Brr
    
17.     d(ar) = d(ar) + 1
    
18. Next
    
19. k = d.keys
    
20. t = d.items
    
21. For i = 0 To UBound(k)
    
22.     Select Case t(i)
    
23.         Case 4
    
24.             Crr(1) = Crr(1) & k(i) & ","
    
25.         Case 3
    
26.             Crr(2) = Crr(2) & k(i) & ","
    
27.         Case 2
    
28.             Crr(3) = Crr(3) & k(i) & ","
    
29.         Case 1
    
30.             Crr(4) = Crr(4) & k(i) & ","
    
31.     End Select
    
32. Next
    
33. For i = 1 To 4
    
34.     If InStr(Crr(i), ",") Then
    
35.         Crr(i) = Left(Crr(i), Len(Crr(i)) - 1)
    
36.         If InStr(Crr(i), ",") Then
    
37.             aa = Split(Crr(i), ",")
    
38.             Cells(i + 3, 15).Resize(1, UBound(aa) + 1) = aa
    
39.             Cells(i + 3, 15).Resize(1, UBound(aa) + 1).Sort Key1:=Cells(i + 3, 15), Order1:=xlAscending, Header:=xlGuess, _
    
40.                 OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, SortMethod _
    
41.                 :=xlPinYin, DataOption1:=xlSortTextAsNumbers
    
42.         Else
    
43.             Cells(i + 3, 15) = Crr(i)
    
44.         End If
    
45.     End If
    
46. Next
    
47. End Sub
    

复制代码

蓝桥玄霜

请见附件。

yyhhhbb

原帖也是你写的。
又见蓝桥老师出手,喜出望外！！！
学了这么久的VBA，此等简单的问题还要求助真是惭愧。

无法形容的感激！
顺祝蓝桥老师节日愉快！！！