ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ª«¥ó±Æ§Ç°ÝÃD"Scripting.Dictionary"

[µo°Ý] ª«¥ó±Æ§Ç°ÝÃD"Scripting.Dictionary"

¥»©«³Ì«á¥Ñ PKKO ©ó 2015-10-6 15:43 ½s¿è

·Q½Ð°Ý¦U¦ì¤j¤j,§ÚSet xd2 = CreateObject("Scripting.Dictionary")
µM«á¤U¤è¶]¦^°é¥i¥H±o¨ì¨â­ÓªF¦è
1:¤£­«½Æªº¦WºÙxd.keys,2:¨C­Ó¦WºÙ¥X²{¹Lªº¦¸¼Æ

°ÝÃD¬O§Ú­n¦p¦ó±o¨ì«e¤T¦W¥X²{¹Lªº¦¸¼Æ¬O´X¦¸?¥H¤Î³o«e¤T¦W¬O½Ö?
  1. '¿é¤J¦¸¼Æ
  2. for °j°é
  3.    xd2(CInt(ar(j))) = xd2(CInt(ar(j))) + 1
  4. next
½Æ»s¥N½X
¤p§Ì¼g±o¥X¨Ó,¦ý¤èªk«Ü·M¬N,·Q½Ð±Ð¦U¦ì¤j¤j¤@©w¦³§ó¦nªº°µªk
¥H¤U¬°¤p§Ìªºµ{¦¡½X(Ãlªø·V¤J!)
§Ú¬O¥ý±NitemsÂର¥t¤@­Ó°}¦C,¦b¥Î°}¦C¶i¦æ±Æ§Ç¤j¤p,µM«á¦A¶]¦^°é¦pªG¦¸¼Æ¬Ûµ¥,´N§â¦WºÙ¨ú¥X,ªÖ©w¦³§ó²©öªº¤èªk,¦]¦¹·Q°Ý°Ý¬Ý¦U¦ì¤j¤jªº¼¶¼g¤èªk!
  1. '§ä¥X³Ì¤jªº¤T­Ó¦¸¼Æ
  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)
½Æ»s¥N½X
PKKO

¦^´_ 1# PKKO
  1. Sub Test()
  2.     Dim xd2:  Set xd2 = CreateObject("Scripting.Dictionary")
  3. '    '¿é¤J¦¸¼Æ
  4. '    for °j°é
  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 "³Ì¦h¦¸: " & dicValue2Key(Application.WorksheetFunction.Large(dicValue2Key.keys, 1))
  20.     Debug.Print "²Ä¤G¦h¦¸: " & dicValue2Key(Application.WorksheetFunction.Large(dicValue2Key.keys, 2))
  21.     Debug.Print "²Ä¤T¦h¦¸: " & dicValue2Key(Application.WorksheetFunction.Large(dicValue2Key.keys, 3))
  22. End Sub
½Æ»s¥N½X
ªí¹F¤£²M¡BÃD·N¤£©ú½T¡B¨SªþÀɮ׮榡¡B¨S¦³°Q½×°ÝÃDªººA«×~~~~~~¥H¤W·R²ö¯à§U¡C

TOP

¥þ³¡¥Î°}¦C±Æ§Ç¡G
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¡@'¦C¥X¥þ³¡
[H1:I1].Resize(3) = Crr¡@'¦C¥X«e¤T¦h

TOP

·PÁ¨â¦ì¤j¤jªº¦^ÂÐ,³£¬O«Ü¦³·N«äªº«äºû,¤p§Ì·|¦n¦n¬ãŪ¤@¤U!¥ýÁÂÁ¤j¤j­Ì¤F!
PKKO

TOP

        ÀR«ä¦Û¦b : ªY½à§O¤H´N¬O²øÄY¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD