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

[µo°Ý] dictionary ¥Îªk

[µo°Ý] dictionary ¥Îªk

¥H¤U¬°§Úªºµ{¦¡½X:
  1. Dim Ar(), d As Object
  2. Set d = CreateObject("scripting.dictionary")
  3. Set dic = CreateObject("scripting.dictionary")
  4. Set dtemp = CreateObject("scripting.dictionary")
  5. Ar = Range("A6:E" & [E6].End(xlDown).Row)

  6. For i = 1 To UBound(Ar)
  7.   If Not dtemp.exists(Left(Ar(i, 2), 4)) Then
  8.   d.Add Ar(i, 2), Ar(i, 4)
  9.   dic.Add Ar(i, 2), Ar(i, 5)
  10.   dtemp.Add Left(Ar(i, 2), 4), Ar(i, 4)
  11.   Else
  12.   d(Ar(i, 2)) = d(Ar(i, 2)) + Ar(i, 4)
  13.   dic(Ar(i, 2)) = dic(Ar(i, 2)) + Ar(i, 5)
  14.   dtemp(Ar(i, 2)) = dtemp(Ar(i, 2)) + Ar(i, 4)
  15.   End If
  16. Next i
½Æ»s¥N½X
Ar ¦s©ñ¤@­Órange
¨ä§Î¦¡ªø³o¼Ë
§Ç        °Ó«~¦WºÙ              ¦¨¥æ³æ»ù        ÁʶR¼Æ¶q
1        131A ¹q¸£        150                 1,000
2        132A                 100                      0
3        55CR ¦B½c        800                      0
4        55CR               1200                  250
5        55CR               1150                  100

¦]¬°¦WºÙ¨Ã¥¼§¹¥þ¬Û¦P
·Q­n¥Îdictionary§¹¦¨¦U¶µ¥[Á`
¥i¬O¤£ª¾¹D¬°¦ódtemp¥i¥H¥[Á`
¦ý¬O d¸òdic´N¤£¦æ?
·PÁÂm(_ _)m

¦^´_ 1# lalalada
·Q­n¥Îdictionary§¹¦¨¦U¶µ¥[Á`,¥i¬O¤£ª¾¹D¬°¦ódtemp¥i¥H¥[Á`,¦ý¬O d¸òdic´N¤£¦æ?
¬Ý¬Ý¬O³o¼Ë¶Ü?
  1. Option Explicit
  2. Sub EX()
  3. Dim Ar(), d As Object, dtemp As Object, dic As Object, i As Integer, xlword(1 To 3) As String
  4.     Set d = CreateObject("scripting.dictionary")
  5.     Set dic = CreateObject("scripting.dictionary")
  6.     Set dtemp = CreateObject("scripting.dictionary")
  7.     Ar = Range("A6:E" & [E6].End(xlDown).Row)
  8.     For i = 1 To UBound(Ar)
  9.         xlword(1) = Ar(i, 2)          '¥þ³¡¦r¦ê
  10.         xlword(2) = Left(Ar(i, 2), 4) '¥N¸¹¦r¦ê
  11.         xlword(3) = Mid(Ar(i, 2), 5)  '«~¦W¦r¦ê
  12.    
  13.         d(xlword(1)) = d(xlword(1)) + Ar(i, 4)
  14.         If xlword(1) <> xlword(2) Then dic(xlword(2)) = dic(xlword(2)) + Ar(i, 5)
  15.         If xlword(3) <> "" Then dtemp(xlword(3)) = dtemp(xlword(3)) + Ar(i, 4)
  16.     Next
  17. End Sub
½Æ»s¥N½X

TOP

¦^´_  lalalada
·Q­n¥Îdictionary§¹¦¨¦U¶µ¥[Á`,¥i¬O¤£ª¾¹D¬°¦ódtemp¥i¥H¥[Á`,¦ý¬O d¸òdic´N¤£¦æ?
¬Ý¬Ý¬O ...
GBKEE µoªí©ó 2012-8-13 12:13


¦n¹³©Ç©Çªº...
³Ì«á¤@¬q
        d(xlword(1)) = d(xlword(1)) + Ar(i, 4)
        If xlword(1) <> xlword(2) Then dic(xlword(2)) = dic(xlword(2)) + Ar(i, 5)
        If xlword(3) <> "" Then dtemp(xlword(3)) = dtemp(xlword(3)) + Ar(i, 4)
·N«ä¤À§O¬O:
¥þ¦W = ¥N½X + «~¦W
¦r¨å1«Ø¥ßÃöÁä¦r(°O¿ý©Ò¦³ÃöÁä¦r¡A³¡¤À¬°¥þ¦W¡A³¡¤À¥u¦³¥N½X)
­Y¥Ø«eªº¥þ¦W¤£¥u¦³¥ªÃä¥N½X «h¦r¨å2(¬ö¿ý¦P®É¦³¥N½X+«~¦W¶µ)¥[¤JÃöÁä¦r¤Î¯Á¤Þ
­Y«~¦W¤£¬°ªÅ¥Õ«h¦r¨å3(¬ö¿ý¦P®É¦³¥N½X+«~¦W¶µ)¥[¤JÃöÁä¦r¯Á¤Þ
³o¼Ë¬Ý°_¨Ó³Ì«áµLªk§â©Ò¦³¬Û¦P¥N½Xªº²£«~¥[Á`¿é¥X?@@
ex. SSSL ¹q¸£   $100    50
      SSSL             $150    25
      SSSL             $50      100
¿é¥X¦¨
SSSL   ¹q¸£   175
³Ì«á¥Ø¼Ð¬O
SSSL   ¹q¸£   $¥­§¡»ù®æ  175

TOP

¥»©«³Ì«á¥Ñ lalalada ©ó 2012-8-13 16:09 ½s¿è

©êºp¤@¶}©l±Ô­z¤£²M
§Ú§â­ì¨Óªºcode¥[¤Wµù¸Ñ
  1. Dim Ar()
  2. Set d = CreateObject("scripting.dictionary")
  3. Set dic = CreateObject("scripting.dictionary")
  4. Set dtemp = CreateObject("scripting.dictionary")
  5. Ar = Range("A6:E" & [E6].End(xlDown).Row)

  6. For i = 1 To UBound(Ar)
  7.   If dtemp.exists(Left(Ar(i, 2), 4)) = False Then  '­Y¦r¨å3¥N½X¥¼¬ö¿ý
  8.   d(Ar(i, 2)) = Ar(i, 4)                            '¦r¨å1¬ö¿ý¥þ¦W¤Î¯Á¤Þ1
  9.   dic(Ar(i, 2)) = Ar(i, 5)                         '¦r¨å2¬ö¿ý¥þ¦W¤Î¯Á¤Þ2
  10.   dtemp(Left(Ar(i, 2), 4)) = Ar(i, 4)              '¦r¨å3¬ö¿ý¥N½X¤Î¯Á¤Þ
  11.     MsgBox "d:" & d(Ar(i, 2)) & d.keys & "  dic:" & dic(Ar(i, 2)) & " dtemp:" & dtemp(Left(Ar(i, 2), 4))
  12.   Else                                                             '­Y¦r¨å3¥N½X¤w°O¿ý
  13.   dtemp(Left(Ar(i, 2), 4)) = dtemp(Left(Ar(i, 2), 4)) + Ar(i, 4) '¦r¨å3¯Á¤Þ1¥[Á`
  14.   d(Ar(i, 2)) = d(Ar(i, 2)) + Ar(i, 4)                          '¦r¨å1(¥þ¦W)¯Á¤Þ1¥[Á`
  15.   dic(Ar(i, 2)) = dic(Ar(i, 2)) + Ar(i, 5)                    '¦r¨å2(¥þ¦W)¯Á¤Þ2¥[Á`
  16.     MsgBox "ELSE    ""d:" & d(Ar(i, 2)) & "  dic:" & dic(Ar(i, 2)) & " dtemp:" & dtemp(Left(Ar(i, 2), 4))
  17.   End If
  18. Next i

  19. [L6].Resize(d.Count, 1) = Application.Transpose(d.keys)          '¿é¥X¥þ¦W
  20. [M6].Resize(d.Count, 1) = Application.Transpose(d.items)      '¿é¥X¯Á¤Þ1
  21. [N6].Resize(dic.Count, 1) = Application.Transpose(dic.items) '¿é¥X¯Á¤Þ2
½Æ»s¥N½X
´«¥y¸Ü»¡
§Æ±æ³Ì«á¯à¿é¥X¦r¨å1ªº¥þ¦W©M¦r¨å3ªº¯Á¤Þ­È...."
¥Ø«e°ÝÃD¥d¦b·í±ø¥ó¬°§_
dtemp¥i½T¹ê¥[Á`¦ýd,dic¤£¦æ(¥Ñmsgbox¥i¥HÆ[¹î¨ì)
·PÁª©¤j¦^´_:)
¥»¨Ó¥H¬°¤w¸g¨I¨ì¶³²`¤£ª¾³B

TOP

¦^´_ 4# lalalada

¤W¶ÇÀÉ®× ¬Ý¬Ý

TOP

¥»©«³Ì«á¥Ñ lalalada ©ó 2012-8-13 16:38 ½s¿è
¦^´_  lalalada
½Ð¶Ç¤WexcelÀÉ®×
GBKEE µoªí©ó 2012-8-13 16:09


ªü ©êºp
§¹¥þ§Ñ°O¥i¥H¤W¶Ç...
§Ú¯u²Â..."
­è­è­«¼g¤F¥ÎDo...Loopªº°µªk
¤]ªþ¦bÀɮ׸Ì
dictionaryªº¤èªk code¸Ìªº°Ñ·Ó¦ì¸m­nµy·L½Õ¾ã¤@¤U¤~¯à¥Î

ProductList.zip (15.97 KB)

TOP

¦^´_ 6# lalalada

Àɮ׸̪ºcode¶K¦¨¨Sµù¸Ñª©ªº¤F..."

ProductList.zip (15.97 KB)

TOP

¦^´_ 7# lalalada
©JÀÉ ¦p¦³¸Ô²Ó»¡©ú ´N¤£·|Ãú¸Ì¬Ýªá¤F
ex. SSSL ¹q¸£   $100    50
      SSSL             $150    25
      SSSL             $50      100
¿é¥X¦¨
SSSL   ¹q¸£   175
³Ì«á¥Ø¼Ð¬O
SSSL   ¹q¸£   $¥­§¡»ù®æ  175

µ{¦¡½X¨ÌªþÀÉÄæ¦ì, ¤u§@ªí1 ªº¸ê®Æ¤w±Æ§Ç¹L  ©w»s
  1. Sub arrange_trial()
  2.     Dim Ar(), Axy(), d As Object, dic As Object, xlword As String
  3.     Set d = CreateObject("scripting.dictionary")
  4.     Set dic = CreateObject("scripting.dictionary")
  5.     Ar = Sheets("¤u§@ªí1").Range("A2:E" & Sheets("¤u§@ªí1").[E2].End(xlDown).Row).Value
  6.     '***  ¤@¯ë¼Ò²Õ¤¤: ¨S«ü©w¤u§@ªíªº Range ¬O·|§@¥Î¤¤¤u§@ªíActiveSheetªºRange   ****
  7.     For i = 1 To UBound(Ar)
  8.         If Len(Ar(i, 2)) > 4 Then xlword = Ar(i, 2)
  9.         If Not d.Exists(xlword) Then
  10.             d(xlword) = Array(Ar(i, 1), Ar(i, 2), , Ar(i, 4), Ar(i, 5))
  11.             dic(xlword) = Array(Ar(i, 3))          'p
  12.         Else
  13.             Axy = d(xlword)   '¨ú±o ¦r¨åª«¥óªºitems
  14.             d(xlword) = Array(Axy(0), Axy(1), , Axy(3) + Ar(i, 4), Axy(4) + Ar(i, 5))
  15.             
  16.             Axy = dic(xlword) '¨ú±o ¦r¨åª«¥óªºitems
  17.             ReDim Preserve Axy(UBound(dic(xlword)) + 1)  '­«¸m Axy¤¸¯À+1(Preserve: ­û¤º®e¤£ÅÜ)
  18.             Axy(UBound(Axy)) = Ar(i, 3)                  '¥[1 ªº¤¸¯À
  19.             dic(xlword) = Axy '¸m¤J ¦r¨åª«¥óªºitems
  20.         End If
  21.     Next
  22.     For Each k In d.keys
  23.         Axy = d(k)
  24.         Axy(2) = Application.Average(dic(k))  '¥­§¡¼Æ
  25.         Axy(2) = Application.Round(Axy(2), 2) '¥|±Ë¤­¤J¨ì¤p¼ÆÂI²Ä2¦ì
  26.         d(k) = Axy
  27.     Next
  28.     Sheets("Output").[a5].Resize(d.Count, UBound(Ar, 2)) = Application.Transpose(Application.Transpose(d.items))
  29. End Sub
½Æ»s¥N½X

TOP

¦^´_ 8# GBKEE

§Ú·|¤F!:P
­ì¨Ó°}¦C³o»ò¦n¥Î...
¥»¨Ó¤£¼ô¥H¬°¤Ï¥¿¥i¥H¥ÎÀx¦s®æ¨ú¥N §Ú­n¦A¦h¬ã¨s..
¦Ó¥Bdictionary³ºµM¥i¥Hª½±µ«ü©w°}¦C
³o¦¸¯uªºÀò¯q¨}¦h
·PÁª©¤j!:)

TOP

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

¸ê®Æªí:


µ²ªGªí °õ¦æ«e:


°õ¦æµ²ªG:



Option Explicit
Sub TEST()
Dim Brr, Y, R&, i&, j&, T$, T0$
Dim xR As Range, Sh1 As Worksheet, Sh2 As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("¤u§@ªí1"): Set Sh2 = Sheets("Output")
Set xR = Sh1.[A1].CurrentRegion: Brr = xR
For i = 2 To UBound(Brr)
   T = Trim(Brr(i, 2))
   If T = "" Then GoTo i01
   If T Like "C### [A-Z]*" Then
      R = R + 1
      T0 = Split(T, " ")(0)
      Y(T0 & "|r") = R: Y(T0 & "|n") = 1: Y(T0 & "|tt") = Brr(i, 3)
      For j = 1 To 5: Brr(R, j) = Brr(i, j): Next
      GoTo i01
   End If
   Y(T & "|n") = Y(T & "|n") + 1
   Y(T & "|tt") = Y(T & "|tt") + Brr(i, 3)
   Brr(Y(T & "|r"), 3) = Round(Y(T & "|tt") / Y(T & "|n"), 2)
   Brr(Y(T & "|r"), 4) = Brr(Y(T & "|r"), 4) + Brr(i, 4)
   Brr(Y(T & "|r"), 5) = Brr(Y(T & "|r"), 5) + Brr(i, 5)
   
i01:
Next
[5:65536].Clear
Sh2.[A5].Resize(R, 5) = Brr
Set Y = Nothing: Set xR = Nothing: Erase Brr
Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ·O´d¨S¦³¼Ä¤H¡A´¼¼z¤£°_·Ð´o¡C
ªð¦^¦Cªí ¤W¤@¥DÃD