| |
▼ゼロワン さん：
> Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ
>１ みかん りんご ぶどう りんご いちご ぶどう りんご
>
> ↓
>
> Ａ Ｂ Ｃ Ｄ
>１ いちご ぶどう×２ みかん りんご×３
>
>となるようにしたいのですが・・・
>この回答は５００７４で確認することができました。自分が知りたいのは、この行が１００、あるいは遥かそれ以上の膨大な行数になった時のコード、もう一つは、１の行の変換は上の例のように、同じ１の行で表示されるようにすること。そのためはじめに表示されているデータは消えても構いません。ようするに同一行に上書きのような形で表示させたいのです。
回答は５００７４のichinoseさんの回答を行でループさせればよいと思います。
後は、早起きのichinoseさんが手直ししてくれると思いますが、
以下のコードでできると思います。
Sub main()
Dim col As Long
Dim myRow As Long
Dim k As Variant
Dim crng As Range
Dim rng As Range
Dim dic As Object
For myRow = 1 To Range("A65536").End(xlUp).Row
Set dic = CreateObject("scripting.dictionary")
Set rng = Range(Cells(myRow, 1), Cells(myRow, 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
Rows(myRow).ClearContents
For Each k In .keys
If .Item(k) = 1 Then
Cells(myRow, col).Value = k
Else
Cells(myRow, col).Value = k & " × " & .Item(k)
End If
col = col + 1
Next
Range(Cells(myRow, 1), Cells(myRow, col)).Sort Key1:=Cells(myRow, 1), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
End With
Set dic = Nothing
Next
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
