|
▼hatena さん:
こんにちは。
>(A列に)より順次下記のようにデータが入ってます。
>3◎
>3×
>3×
>3×
>2◎
>2×
標準モジュールに
'==========================================================
Sub main()
Dim dic As Object
Dim crng As Range
Dim rng As Range
Dim cnt As Long
Set rng = Range("a1", Cells(Rows.Count, 1).End(xlUp))
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 + 2, 1), Cells(rng.Count + 1 + .Count, 1)).Value = Application.Transpose(.Keys)
Range(Cells(rng.Count + 2, 2), Cells(rng.Count + 1 + .Count, 2)).Value = Application.Transpose(.Items)
End With
Set dic = Nothing
End Sub
>このカウント方法について教えてください。
>尚値は固定ではないので、毎回セルから値をとって、その数を数えたいです。
>っで最終行に
>3◎-1個
>3×-3個...と書かせたい
>
>
>また応用として
>
>(A列に) (B)
>3◎ 3
>3× 2
>3× 2
>3× 1
>2◎ 1
>2× 1
>同じく最終行に
>3◎-3の数1個
>3×-2の数2個
>3×-1の数1個
標準モジュールに
'===============================================================
Sub main2()
Dim dic As Object
Dim crng As Range
Dim rng As Range
Dim cnt As Long
Set rng = Range("a1", Cells(Rows.Count, 1).End(xlUp))
Set dic = CreateObject("scripting.dictionary")
With dic
For Each crng In rng
If .Exists(CStr(crng.Value & "-" & crng.Offset(0, 1).Value)) Then
.Item(CStr(crng.Value & "-" & crng.Offset(0, 1).Value)) = .Item(CStr(crng.Value & "-" & crng.Offset(0, 1).Value)) + 1
Else
.Add CStr(crng.Value & "-" & crng.Offset(0, 1).Value), 1
End If
Next
Range(Cells(rng.Count + 2, 1), Cells(rng.Count + 1 + .Count, 1)).Value = Application.Transpose(.Keys)
Range(Cells(rng.Count + 2, 2), Cells(rng.Count + 1 + .Count, 2)).Value = Application.Transpose(.Items)
End With
Set dic = Nothing
End Sub
いづれも対象シートをアクティブにして実行してみて下さい
|
|