c_c_lai

¦^´_ 6# ziv976688
¦^´_ 7# starry1314

¤U¸ü (45.7 KB)

2016-2-18 09:32

Dic.rar (71.65 KB)

¤U¸ü¦¸¼Æ: 0

2016-2-18 09:32

c_c_lai

¦^´_ 9# ziv976688

1. Sub Ex()
   
2.     Dim dic As Object, rng As Range, fld As Range, txt As String
   
3.    
   
4.     Set rng = Range("B2:H" & [H65536].End(xlUp).Row)
   
5.     Set dic = CreateObject("scripting.dictionary")
   
6.    
   
7.     [K:O].Clear
   
8.     For Each fld In rng
   
9.         txt = fld.Value
   
10.         If dic.exists(txt) = False Then
    
11.             dic(txt) = 1
    
12.         Else
    
13.             dic(txt) = dic(txt) + 1
    
14.         End If
    
15.     Next
    
16.    
    
17.     [K1] = "  ¥Ñ¤p¦Ó¤j¨Ì§Ç±Æ¦C"
    
18.     [K2].Resize(UBound(dic.KEYS) + 1) = Application.Transpose(dic.KEYS)                '  ¯Á¤Þ­È´N¬O Keys
    
19.     [L2].Resize(UBound(dic.KEYS) + 1) = Application.Transpose(dic.Items)               '  ¸ê®Æ¤º®e´N¬O Items
    
20. 
    
21.     With [K2].Resize(UBound(dic.KEYS) + 1, 2)        '  Range("K2:L" & [L2].End(xlDown).Row)
    
22.         .Cells.Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo     ' xlDescending
    
23.     End With
    
24.    
    
25.     Range("K2:L" & [L65536].End(xlUp).Row).Copy [N2]
    
26.    
    
27.     [N1] = "¨Ì¥X²{¾÷²v¼Æ¾Ú±Æ¦C"
    
28.     With [N2].Resize(UBound(dic.KEYS) + 1, 2)        '  Range("N2:O" & [O2].End(xlDown).Row)
    
29.         .Cells.Sort Key1:=.Cells(2), Order1:=xlDescending, Header:=xlNo     ' xlAscending
    
30.     End With
    
31. End Sub

½Æ»s¥N½X