| 
    
     |  | こんにちは 
 シートのイベントで作ってみました。
 該当のシートモジュールに記載
 動作:セルA1に値を入力後「enter」等でセルが移動すると動作します。
 
 Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Fi As Range, Ad As String, R As Range, Co As Long
 With Target
 If .Cells.Count > 1 Then Exit Sub
 If .Address(0, 0) <> "A1" Then Exit Sub
 If .Value = "" Then Exit Sub
 Set R = Range("B2", Range("B65536").End(xlUp))
 Set Fi = R.Find(.Value, , xlValues, xlWhole)
 Application.EnableEvents = False
 R.Offset(, -1).ClearContents
 If Not Fi Is Nothing Then
 Ad = Fi.Address: Co = 0
 Do
 Set Fi = R.FindNext(Fi)
 Fi.Offset(, -1).Value = "○"
 Co = Co + 1
 Loop Until Ad = Fi.Address
 MsgBox "一致したデータは「" & Co & "」です。", vbInformation
 Else
 MsgBox "一致データはありませんでした。", vbInformation
 End If
 Application.EnableEvents = True
 Set Fi = Nothing
 End With
 End Sub
 
 |  |