| 
    
     |  | >シート1のモジュールに >'======================================================
 >Private Sub Worksheet_Change(ByVal Target As Range)
 >  Dim rtarget As Range
 >  Dim crng As Range
 >  Dim color_rng As Range
 >  On Error Resume Next
 >  Set rtarget = Application.Intersect(Target, Range("b:b"))
 >  If Not rtarget Is Nothing Then
 >   For Each crng In rtarget
 >     Err.Clear
 Set color_rng = Worksheets("sheet2").Range(Replace(crng.Text, "-", ""))
 '     訂正して下さい、これで済みます
 >     If Err.Number = 0 Then
 >      color_rng.Offset(0, 1).Interior.ColorIndex = 3
 >      End If
 >     Next
 >   End If
 >  On Error GoTo 0
 >End Sub
 >
 
 
 |  |