[µo°Ý] ¬°¦óµLªk¨ú¥XdictionaryÅܧóitem¤§«áªº­È©O

dechiuan999

¦U¦ì¤j¤j¦n¡G
   ¤p§Ì¹ïdictionaryªºÀ³¥Î¤´¬O°±¯d¦b
¤@ª¾¥b¸Ñ¡C
  ²{¤p§Ì¹ï¤U¦C»yªkªºÀ³¥ÎµLªk¬ð¯}
²~ÀV¡A·Ð½Ð¦U¦ì¤j¤j¯àÀ°¦£¸Ñ´b¡C
»yªk¦p¤U¡G
Sub aa()   
    Dim mDic As Scripting.Dictionary
    Dim mRng As Range, mRng1 As Range, mRng2 As Range, E As Range
    Dim mSht As Worksheet
    Dim mKey, mItem
    Dim s%, s1%, m1%, m2%
    Dim mTmp$, mTmp1$
   
    Set mSht = Worksheets(1)
    With mSht
        Set mRng1 = .Range("e1:e17")
        Set mRng2 = .Range("h1:h17")
        
        Set mDic = CreateObject("scripting.dictionary")
        For Each E In mRng1
            If mDic.Exists(E.Value) = False Then
                mDic(E.Value) = 1
            Else
                mDic(E.Value) = mDic(E.Value) + 1
            End If
        Next
        
        For Each E In mRng2
            If mDic.Exists(E.Value) = False Then
                mDic(E.Value) = 1
            Else
                mDic(E.Value) = mDic(E.Value) + 1
            End If
        Next
        
        
        mKey = mDic.Keys
        mItem = mDic.Items
        
        For s = 0 To mDic.Count - 1
            
            If mKey(s) = "d" Then
               
                m1 = mItem(s)
               
            End If
            
            If mKey(s) = "e" Then
            
                m2 = mItem(s)
            
            End If
            
        Next
        
        For s = 0 To mDic.Count
        
            If mKey(s) = "f" Then
                mItem(s) = mItem(s) + m1 + m2
                Exit For
            End If
        Next
        
        Set mRng = .Range("a1:a4")
        
        For Each E In mRng          '¦¹»yªk¦p¦ó­×¥¿¤~¯à¨ú¥X¥¿½Tªºitem­È©O
            
            E.Offset(, 1) = mDic(E.Value)   '¦¹»yªkµLªk¨ú¥XÅܧó«á¤§item­È¦Ó¬O¨ú¥XÅܧ󤧫eªº­È©O¡H
        Next
        
        For s = 0 To mDic.Count - 1      '¤U¦C»yªk«o¥i¨ú¥XÅܧó«áªºitem ­È©O¨ä­ì¦]¬°¦ó¡H
            
            Set mRng = .Range("a1:a4").Find(what:=mKey(s), lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)
            
            If Not mRng Is Nothing Then
                mRng.Offset(, 1) = mItem(s)
            End If
            
        Next
    End With
   
End Sub

ÁÂÁ¦U¦ì¤j¤j¡C

dechiuan999

ÁÂÁª©¥D¤j¤j¡C
ª©¥D¤j¤j©Ò´£¨Ñªº»yªk¦p¦¹
²©ú¡A«o¬O¦p¦¹¦h¼ËÅܤơC
±q¤W­z¨Ò¤l©úÅã¥i¬Ý¥X¨ä
key©Mitem ¤§ÅܤƧ¹¥þ¦b
d(E)ª«¥ó¤§¤U§¹¦¨¡C

¤p§Ì¤]¦Û¦æ­×¥¿´£¥X°Ý
ÃD¤§»yªk¦p¤U¡G
Sub aa()
   
    Dim mDic As Scripting.Dictionary
    Dim mRng As Range, mRng1 As Range, mRng2 As Range, E As Range
    Dim mSht As Worksheet
    Dim mKey, mItem
    Dim s%, s1%, m1%, m2%
    Dim mTmp$, mTmp1$
   
    Set mSht = Worksheets(1)
    With mSht
        Set mRng1 = .Range("e1:e17")
        Set mRng2 = .Range("h1:h17")
        
        Set mDic = CreateObject("scripting.dictionary")
        For Each E In mRng1
            If mDic.Exists(E.Value) = False Then
                mDic(E.Value) = 1
            Else
                mDic(E.Value) = mDic(E.Value) + 1
            End If
        Next
        
        For Each E In mRng2
            If mDic.Exists(E.Value) = False Then
                mDic(E.Value) = 1
            Else
                mDic(E.Value) = mDic(E.Value) + 1
            End If
        Next
        
        
        mKey = mDic.Keys
        mItem = mDic.Items
        
        For s = 0 To mDic.Count - 1            
            If mKey(s) = "d" Then               
                m1 = mItem(s)               
            End If            
            If mKey(s) = "e" Then            
                m2 = mItem(s)            
            End If            
        Next        
        For s = 0 To mDic.Count - 1  '­×¥¿¤º®e
        
            If mKey(s) = "f" Then
                mDic(mKey(s)) = mDic(mKey(s)) + m1 + m2
            End If            
        Next        
        Set mRng = .Range("a1:a4")        
        For Each E In mRng
            E.Offset(, 1) = mDic(E.Value)
        Next               
    End With
   
End Sub
¤p§Ì¯u¬O¨ü¯q¨}¦h¡C
«D±`·P®¦ª©¥D¤j¤j¡C

GBKEE

¦^´_ 3# dechiuan999

1. Sub Ex()
   
2.     Dim D As Object, AR(), E As Variant
   
3.     Set D = CreateObject("SCRIPTING.DICTIONARY")
   
4.     AR = Array("A", "B", "C", "D", "E")
   
5.     For Each E In AR
   
6.         D(E) = LCase(E)
   
7.     Next
   
8.     MsgBox Join(D.Keys, ",") & Chr(10) & Join(D.Items, ",")
   
9.     AR = Array("A", "B", "C", "D", "E", "F", "G", "H")
   
10.     For Each E In AR
    
11.         D(E) = E & D(E)
    
12.    Next
    
13.    MsgBox Join(D.Keys, ",") & Chr(10) & Join(D.Items, ",")
    
14. End Sub

½Æ»s¥N½X

dechiuan999

ÁÂÁª©¥D¤j¤j¡C
mKey = mDic.Keys  ,  mItem = mDic.Items   ->¤À§O¬°¨úªº mDic ªº Keys  ¤Î  mDic ªº Items ¤§°}¦C
§ïÅÜ mItem °}¦Cªº­È ¥u¬O§ïÅܳo°}¦C   ,mDic.Items¨Ã¨S¦³§ïÅÜ°Ú .
For Each E In mRng1
            If mDic.Exists(E.Value) = False Then
                mDic(E.Value) = 1                  <-³o¸Ì¤~¬O§ïÅÜ Item     
            Else
                mDic(E.Value) = mDic(E.Value) + 1  <-         ³o¸Ì¤~¬O§ïÅÜ Item
            End If
Next
·Óª©¥D¤j¤jªº¸Ñ»¡¡A¤p§Ìªº·Qªk¤£ª¾¬O§_¥¿½T¡AÁٽЪ©¥D«üÂI¡C
¤]´N¬O»¡­n§ïÅÜkey¤Îitemªº­È¬O¶·¦bmdic¦¹ª«¥ó¤U¤~¥i

GBKEE

¦^´_ 1# dechiuan999
mKey = mDic.Keys  ,  mItem = mDic.Items   ->¤À§O¬°¨úªº mDic ªº Keys  ¤Î  mDic ªº Items ¤§°}¦C
§ïÅÜ mItem °}¦Cªº­È ¥u¬O§ïÅܳo°}¦C   ,mDic.Items¨Ã¨S¦³§ïÅÜ°Ú .

For Each E In mRng1
            If mDic.Exists(E.Value) = False Then
                mDic(E.Value) = 1                  <-³o¸Ì¤~¬O§ïÅÜ Item     
            Else
                mDic(E.Value) = mDic(E.Value) + 1  <-         ³o¸Ì¤~¬O§ïÅÜ Item
            End If
Next