Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

2014 / 76734

←次へ　｜　前へ→


	【80364】Re:カレンダーに予定を自動入力したい

γ - 19/2/1(金) 11:59 -


	引用なし

	パスワード

カレンダには日付データが、日を表示するだけの形式でセットされているとの前提です。
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

7 hits

▼

【80354】カレンダーに予定を自動入力したい VBA初心者 19/1/31(木) 12:44