Excel総合相談所 138

[602 名無しさん＠そうだ選挙にいこう 2020/04/10(金) 13:59:39.89]

>>600
Sub Macro1()
　　Dim k()
　　Dim Dic As Object
　　Set Dic = CreateObject("Scripting.Dictionary")
　　With Dic
　　　　For Each c In ActiveSheet.UsedRange
　　　　　　t = c.Text
　　　　　　If t <> "" Then
　　　　　　　　If .Exists(t) Then
　　　　　　　　　　.Item(t) = .Item(t) + 1
　　　　　　　　Else
　　　　　　　　　　.Add t, 1
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　　　ActiveSheet.UsedRange.Clear
　　　　k = .Keys
　　　　For r = 1 To .Count
　　　　　　For c = 1 To .Item(k(r - 1))
　　　　　　　　Cells(r, c) = k(r - 1)
　　　　　　Next
　　 Next
　　End With
　　With ActiveSheet.Sort
　　　　.SortFields.Add2 Key:=Range("A1")
　　　　.SetRange ActiveSheet.UsedRange
　　　　.Apply
　　End With
End Sub