GBKEE

¦^´_ 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

GBKEE

¦^´_ 4# lalalada

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

GBKEE

¦^´_ 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