| |
カレンダには日付データが、日を表示するだけの形式でセットされているとの前提です。
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
|
|
γ
- 19/2/1(金) 11:59 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
