|
▼まさひで さん:
1)データを1個ずつ辞書に登録
2)新規シートに登録結果を書き出し
3)回数の多い順に並べ替え
4)回数の多いものトップ5でフィルター
Sub test()
Dim dic As Object
Dim c As Range
Set dic = CreateObject("scripting.dictionary")
For Each c In Range("a1").CurrentRegion '★データ範囲
dic(c.Value) = dic(c.Value) + 1
Next
With Worksheets.Add
.Range("a1:b1").Value = Array("番号", "回数")
.Range("a2").Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.keys)
.Range("b2").Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.items)
With .Range("a1").CurrentRegion
.Sort Key1:=.Columns(2), Order1:=xlDescending, Header:=xlYes
.AutoFilter Field:=2, Criteria1:="5", Operator:=xlTop10Items
End With
End With
End Sub
|
|