| 
    
     |  | ▼hatena さん: こんばんは。
 
 >たびたびすみません
 >
 >結果を並べ替えをして表示させることは可能ですか?
 >今は、セルの順に
 >3◎ 1
 >3× 1
 >2◎ 3
 >ですが
 >2◎ 3
 >3◎ 1
 >3× 1
 >とさせたいのです。
 Excelは並べ替えができますよね?
 
 
 この前のご質問と合わせて(1行目が項目名の場合)・・・、
 
 '=================================
 Sub main()
 Dim dic As Object
 Dim crng As Range
 Dim rng As Range
 Dim cnt As Long
 Set rng = Range("a2", Cells(Rows.Count, 1).End(xlUp)) '*
 If rng.Row > 1 Then '*
 Set dic = CreateObject("scripting.dictionary")
 With dic
 For Each crng In rng
 If .Exists(CStr(crng.Value)) Then
 .Item(CStr(crng.Value)) = .Item(CStr(crng.Value)) + 1
 Else
 .Add CStr(crng.Value), 1
 End If
 Next
 Range(Cells(rng.Count + 3, 1), Cells(rng.Count + 2 + .Count, 1)).Value = Application.Transpose(.Keys)
 Range(Cells(rng.Count + 3, 2), Cells(rng.Count + 2 + .Count, 2)).Value = Application.Transpose(.Items)
 Range(Cells(rng.Count + 3, 1), Cells(rng.Count + 2 + .Count, 2)).Sort Key1:=Cells(rng.Count + 3, 2), Order1:=xlDescending, Header:=xlNo
 '↑ソートする
 End With
 Set dic = Nothing
 End If
 End Sub
 
 
 main2も同じように修正してください。
 
 |  |