| 
    
     |  | ▼γ さん: >カレンダには日付データが、日を表示するだけの形式でセットされているとの前提です。
 >straightforwardに、こんなコードではどうでしょうか。
 >
 >Sub カレンダー入力2()
 >  Dim ws     As Worksheet
 >  Dim lastRow   As Long
 >  Dim rngCalendar As Range
 >  Dim rngFound  As Range
 >  Dim d      As Long
 >  Dim s      As String
 >  Dim k      As Long
 >
 >  Set ws = Worksheets("Sheet1")
 >  lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
 >  Set rngCalendar = ws.Range("E1:K10")
 >
 >  For k = 1 To lastRow
 >    d = ws.Cells(k, "A").Value '日付け
 >    s = ws.Cells(k, "B").Value 'スケジュール
 >    Set rngFound = rngCalendar.find(Day(d), After:=rngCalendar(1), _
 >      LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
 >      MatchCase:=False, MatchByte:=False, SearchFormat:=False)
 >
 >    '日でマッチさせると、たかだか2回マッチするだけなのでDo Loopは不要?
 >    If d = rngFound.Value Then
 >      Call setSchedule(rngFound.Offset(1, 0), s)
 >    Else
 >      Set rngFound = rngCalendar.FindNext(rngFound)
 >      If Not rngFound Is Nothing Then
 >        If d = rngFound.Value Then
 >          Call setSchedule(rngFound.Offset(1, 0), s)
 >        End If
 >      End If
 >    End If
 >  Next
 >End Sub
 >Function setSchedule(r As Range, s As String)
 >  If r.Value = "" Then
 >    r.Value = s
 >  Else
 >    r.Value = r.Value & vbLf & s
 >  End If
 >End Function
 
 γ様
 
 いつもお世話になっております。
 γ様のvbaを参考に自分で作成してみたのですが
 
 If d = rngFound.Value Then
 Call setSchedule(rngFound.Offset(1, 0), s)
 Else
 Set rngFound = rngCalendar.FindNext(rngFound)
 If Not rngFound Is Nothing Then
 If d = rngFound.Value Then
 Call setSchedule(rngFound.Offset(1, 0), s)
 
 ↑の部分がうまくいきません。
 原因として考えられるのは、検索した結果(rngFound)がdと一つも当てはまらなかった場合の処理が入っていないということかなと思うのですが、その場合どうすればいいでしょうか?
 
 自分としてはIf Not rngFound Is Nothing Thenを使えばいいと思い、何度か組んでみたのですがすべてエラーになってしまうので、教えていただきたいです。
 
 |  |