FAlonso

1. Sub my()
   
2. Dim mydic As Object, mycell As Range, i As Integer, j As Integer, ar()
   
3. Set mydic = CreateObject("scripting.dictionary")
   
4. For Each mycell In Range([b1], [b65536].End(xlUp))
   
5. If mydic.exists(mycell.Value) Then
   
6. mydic(mycell.Value) = mydic(mycell.Value) + 1
   
7. Else
   
8. mydic(mycell.Value) = 1
   
9. j = mycell.Row
   
10. i = i + 1
    
11. ReDim Preserve ar(i)
    
12. ar(i) = j
    
13. End If
    
14. Next
    
15. For i = 1 To UBound(ar)
    
16. Cells(ar(i), 3).Value = mydic(Cells(ar(i), 2).Value)
    
17. Next
    
18. Set mydic = Nothing
    
19. End Sub

½Æ»s¥N½X

µ{¦¡¼g¨ì¤@¹ÎÁV,«j±j§¹¦¨