Board logo

標題: [發問] 物件排序問題"Scripting.Dictionary" [打印本頁]
作者: PKKO    時間: 2015-10-6 15:39     標題: 物件排序問題"Scripting.Dictionary"

本帖最後由 PKKO 於 2015-10-6 15:43 編輯

想請問各位大大,我Set xd2 = CreateObject("Scripting.Dictionary")
然後下方跑回圈可以得到兩個東西
1:不重複的名稱xd.keys,2:每個名稱出現過的次數

問題是我要如何得到前三名出現過的次數是幾次?以及這前三名是誰?
  1. '輸入次數
  2. for 迴圈
  3.    xd2(CInt(ar(j))) = xd2(CInt(ar(j))) + 1
  4. next
複製代碼
小弟寫得出來,但方法很愚昧,想請教各位大大一定有更好的做法
以下為小弟的程式碼(攏長慎入!)
我是先將items轉為另一個陣列,在用陣列進行排序大小,然後再跑回圈如果次數相等,就把名稱取出,肯定有更簡易的方法,因此想問問看各位大大的撰寫方法!
  1. '找出最大的三個次數
  2. aar = Split(Join(xd2.items, ","), ",")
  3. ReDim cc(0 To UBound(aar), 1 To 1)
  4. For j = 0 To UBound(aar)
  5.     cc(j, 1) = CInt(aar(j))
  6. Next
  7. a1 = 0: a2 = 0: a3 = 0
  8. For j = 0 To UBound(aar)
  9.       If a1 = 0 Then a1 = Application.WorksheetFunction.Large(cc, j + 1)
  10.       If Application.WorksheetFunction.Large(cc, j + 1) <> a1 And a2 = 0 Then
  11.           a2 = Application.WorksheetFunction.Large(cc, j + 1)
  12.       End If
  13.       If Application.WorksheetFunction.Large(cc, j + 1) <> a1 And Application.WorksheetFunction.Large(cc, j + 1) <> a2 And a3 = 0 Then
  14.           a3 = Application.WorksheetFunction.Large(cc, j + 1)
  15.       End If
  16. Next
  17. str1 = a1 & "次:": str2 = a2 & "次:": str3 = a3 & "次:"
  18. For Each e In xd2.keys
  19.       If xd2(CInt(e)) = a1 Then str1 = str1 & CInt(e) & ","
  20.       If xd2(CInt(e)) = a2 Then str2 = str2 & CInt(e) & ","
  21.       If xd2(CInt(e)) = a3 Then str3 = str3 & CInt(e) & ","
  22. Next
  23. If a1 <> 0 Then str1 = Left(str1, Len(str1) - 1)
  24. If a2 <> 0 Then str2 = Left(str2, Len(str2) - 1)
  25. If a3 <> 0 Then str3 = Left(str3, Len(str3) - 1)
複製代碼
作者: stillfish00    時間: 2015-10-7 17:21

回復 1# PKKO
  1. Sub Test()
  2.     Dim xd2:  Set xd2 = CreateObject("Scripting.Dictionary")
  3. '    '輸入次數
  4. '    for 迴圈
  5. '       xd2(CInt(ar(j))) = xd2(CInt(ar(j))) + 1
  6. '    Next
  7.    
  8.     Dim dicValue2Key: Set dicValue2Key = CreateObject("Scripting.Dictionary")
  9.     Dim xItem
  10.     For Each x In xd2.keys
  11.         xItem = xd2(x)
  12.         If Not dicValue2Key.exists(xItem) Then
  13.             dicValue2Key(xItem) = x
  14.         Else
  15.             dicValue2Key(xItem) = dicValue2Key(xItem) & "," & x
  16.         End If
  17.     Next
  18.    
  19.     Debug.Print "最多次: " & dicValue2Key(Application.WorksheetFunction.Large(dicValue2Key.keys, 1))
  20.     Debug.Print "第二多次: " & dicValue2Key(Application.WorksheetFunction.Large(dicValue2Key.keys, 2))
  21.     Debug.Print "第三多次: " & dicValue2Key(Application.WorksheetFunction.Large(dicValue2Key.keys, 3))
  22. End Sub
複製代碼
作者: 准提部林    時間: 2015-10-7 22:07

全部用陣列排序：
Arr = xD2.keys
Brr = xD2.items
Y = xD2.Count
ReDim Crr(1 To Y, 1 To 2)
For i = 1 To Y
　　For j = i - 1 To 1 Step -1
　　　　If Brr(i - 1) < Crr(j, 2) Then Exit For
　　　　Crr(j + 1, 1) = Crr(j, 1)
　　　　Crr(j + 1, 2) = Crr(j, 2)
　　Next j
　　　　Crr(j + 1, 1) = Arr(i - 1)
　　　　Crr(j + 1, 2) = Brr(i - 1)
Next i
[F1:G1].Resize(Y) = Crr　'列出全部
[H1:I1].Resize(3) = Crr　'列出前三多
作者: PKKO    時間: 2015-10-8 22:30

感謝兩位大大的回覆,都是很有意思的思維,小弟會好好研讀一下!先謝謝大大們了!



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)