| |
▼アーサー さん：
こんばんは。
>こんなこと出来ないでしょうか？
１行目が
> Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ
>１ ５Ｂ ３Ｙ １Ａ ３Ｙ ４Ｂ ５Ｂ １Ａ ３Ｙ
>
となっているデータから、
> ↓
>
> Ａ Ｂ Ｃ Ｄ
２ １Ａ×２ ３Ｙ×３ ４Ｂ ５Ｂ×２
２行目に上記にまとめる事を考えると・・・、
標準モジュールに
'=============================================================
Sub main()
Dim col As Long
Dim k As Variant
Dim crng As Range
Dim rng As Range
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
Set rng = Range("a1", Cells(1, Columns.Count).End(xlToLeft))
With dic
For Each crng In rng
If .Exists(crng.Value) = False Then
.Add crng.Value, 1
Else
.Item(crng.Value) = .Item(crng.Value) + 1
End If
Next
col = 1
For Each k In .Keys
If .Item(k) = 1 Then
Cells(2, col).Value = k
Else
Cells(2, col).Value = k & " × " & .Item(k)
End If
col = col + 1
Next
Range("A2", Cells(2, col)).Sort Key1:=Range("A2"), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
End With
Set dic = Nothing
End Sub
これで試してみてください。
|
|
ichinose
- 07/7/7(土) 23:48 -
