¦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 |