| |
こんにちは
シートのイベントで作ってみました。
該当のシートモジュールに記載
動作：セルＡ１に値を入力後「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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
