Excel VBA質問箱 IV

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

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


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

2028 / 76807

←次へ　｜　前へ→


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

VBA初心者 - 19/2/13(水) 14:12 -


	引用なし

	パスワード

▼マナさん：
>▼VBA初心者さん：
>
>>Worksheet(1月～12月)にカレンダーを表示させてあります。
>
>まず、１月のシートだけで、ちゃんと動くものにしてください。

マナ様
いつもお世話になっております。
お返事ありがとうございます。

1月のシートのみでしたらγ様が教えてくださったコードで動きました。

Sub カレンダー入力新規()
　　Dim ws1　　　　 As Worksheet
　　Dim ws2　　　　 As Worksheet
　　Dim lastRow　　 As Long
　　Dim rngCalendar As Range
　　Dim rngFound　　As Range
　　Dim rngFirstcell As Range
　　Dim d　　　　　 As Long
　　Dim s　　　　　 As String
　　Dim k　　　　　 As Long
　　Dim i　　　　　 As Long
　　Dim j　　　　　 As Long
　　

　　Set ws1 = Worksheets("Sheet1")
　　Set ws2 = Worksheets("1月")
　　lastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
　　
　　Set rngCalendar = ws2.Range("A1:H14")

　　　For k = 1 To lastRow
　　　　　d = ws1.Cells(k, 1).Value　'日付け
　　　　　s = ws1.Cells(k, 2).Value　'スケジュール
　　　　　i = CLng(d) '日付をシリアル値に変更
　　　　
　　　　
　　　　　Set rngFound = rngCalendar.Find(i, After:=rngCalendar(1), _
　　　　　　LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
　　　　　　MatchCase:=False, MatchByte:=False, SearchFormat:=False)
　　
　　　　
　　　　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 k
　　
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

これです！

0 hits

▼

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