| 
    
     |  | どもども 
 >これでは、無限ループに突入してします、
 >どうしたらいいでしょうか?
 
 無限ループにはならないと思うけど……
 
 Target.Value = ""
 
 ここを通ったとき、確かにもう一度Changeイベントが発生したりはしますね。
 
 For Each セル In MyR
 
 の途中でまたChangeイベントが発生するのって、どうかな?と思うので、
 こうしたらどうでしょうか?
 
 Private Sub Worksheet_Change(ByVal Target As Range)
 
 Dim MyR As Range
 Dim セル As Range
 Dim blnFlag As Boolean
 
 blnFlag = False
 
 If Target.Value <> "" Then
 
 Set MyR = Columns("A:A").SpecialCells(xlCellTypeConstants, 23)
 For Each セル In MyR
 If (Target.Value = セル.Value) And (Target.Row <> セル.Row) Then
 Cells(Target.Row, Target.Column).Select
 MsgBox Target.Value & "は、入力済みです"
 blnFlag = True
 Exit For
 End If
 Next
 
 Set MyR = Nothing
 Set セル = Nothing
 End If
 
 If blnFlag = True Then Target.Value = ""
 
 End Sub
 
 一度ステップ実行して動きを確かめて見てください。
 
 ところで、バッティングときに、A列の行と同行の時はOKなわけなんですね?
 
 |  |