| 
    
     |  | 最初の質問は >A列に) (B)
 >3◎    3
 >3×    2
 >3×    2
 >3×    1
 >2◎    1
 >2×    1
 >同じく最終行に
 >3◎-3の数1個
 >3×-2の数2個
 >3×-1の数1個
 >・・    とパターンがあるだけ書かせたいのです、
 
 ということになってましたよね ? なのでそのように変更したわけですが、
 今度は「B列のみの集計」にしたい、という意味でしょーか ? それなら
 06/2/9(木) 15:00 に提示したコードを改造して
 
 Sub MyCount3()
 Dim MyR As Range
 Dim Flg As Boolean
 
 With Range("B:B").SpecialCells(2).Areas
 If .Count > 1 Then .Item(2).Resize(, 2).ClearContents
 End With
 Set MyR = Range("B1", Range("B65536").End(xlUp))
 If MyR.ListHeaderRows = 0 Then
 Flg = True: Application.ScreenUpdating = False
 Rows(1).Insert xlShiftDown
 Range("B1").Value = "[COUNT]"
 End If
 Range("B1", Range("B65536").End(xlUp)).AdvancedFilter _
 xlFilterCopy, , Range("B65536").End(xlUp).Offset(2), True
 With Range("B65536").End(xlUp).CurrentRegion
 .Offset(, 1).Formula = _
 "=COUNTIF(" & MyR.Address & "," & .Range("B1").Address(0, 0) & ")"
 .Offset(, 1).Value = .Offset(, 1).Value
 .Offset(, 1).Range("A1").ClearContents
 End With
 If Flg Then
 Rows(1).Delete xlShiftUp
 Application.ScreenUpdating = True
 End If
 Set MyR = Nothing
 End Sub
 
 と、すれば良いと思います。あとはこれを応用して、自分で考えてみて下さい。
 
 |  |