| 
    
     |  | ▼たつ さん: 
 >同じ日付が続く場合、コピーして日付を入力しようと、
 >K列に同時に複数の値を入れると、一つのセルしか隣のセルに値が表示されません
 >これを回避するにはどうしたらよいのでしょうか?
 
 入力した(複数)セル範囲と K列との共通するセル範囲をIntersectで抽出して
 この範囲を 順にLoopしていけば良いと思います。
 
 また、日付の検索は Findメソッドより ワークシート関数のMATCHを使ったほうが
 セルの書式に左右されないので、確実かと思います。
 
 Private Sub Worksheet_Change(ByVal Target As Range)
 Dim myTarget As Range
 Dim 指定Day As Long, 基準Day As Long
 Dim myDate As Date, 基準Date As Date
 
 LastR = Range("A" & Rows.Count).End(xlUp).Row
 Set myTarget = Intersect(Range("K2").Resize(LastR - 1), Target) 'K列範囲
 If myTarget Is Nothing Then Exit Sub
 
 Application.EnableEvents = False
 
 Dim rngLookUp As Range
 Dim m As Variant
 With Sheets("MDay") '検索先範囲
 Set rngLookUp = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
 End With
 For Each c In myTarget
 c(1, 2).ClearContents      'L列をクリア
 myDate = c.Value        'K列
 基準Date = c.Offset(, -4).Value 'G列
 m = Application.Match(CLng(myDate), rngLookUp, 0)
 If IsNumeric(m) Then
 指定Day = rngLookUp.Item(m, 2).Value
 m = Application.Match(CLng(基準Date), rngLookUp, 0)
 If IsNumeric(m) Then
 基準Day = rngLookUp.Item(m, 2).Value
 c(1, 2).Value = 指定Day - 基準Day - 10 'L列
 End If
 End If
 Next
 
 Application.EnableEvents = True
 
 End Sub
 
 |  |