Excel VBA質問箱 IV

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

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


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

1892 / 76734

←次へ　｜　前へ→


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

VBA初心者 - 19/2/18(月) 14:09 -


	引用なし

	パスワード

▼マナさん：
>▼VBA初心者さん：
>
>>カレンダーには
>>エクセルの年カレンダー(1つのタブで１か月)というものを使っております。
>>表示されている日数は日付のみです。
>
>
>γさんの回答のように、Day(d)で検索しなくて大丈夫？
>本当に、シリアル値 CLng(d)で検索ができていますか。

Day(d)で検索するマクロを考えてみました。
ですが、これだとエラーは出ないものの正しく入力されませんでした。
なぜ入力されないか教えていただきたいです。

Sub カレンダー入力新規2()

　　Dim ws1　　　　　As Worksheet
　　Dim lastRow　　　As Long
　　Dim rngCalendar　As Range
　　Dim rngFound　　 As Range
　　Dim rngFirstcell As Range
　　
　　Dim A　　　　　　As Long
　　
　　Dim h　　　　　　As Long
　　Dim i　　　　　　As String
　　Dim j　　　　　　As Long
　　Dim k　　　　　　As Long
　　Dim l　　　　　　As String
　　
　　Set ws1 = Worksheets("Sheet1")
　　lastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
　　
　　For A = 1 To lastRow
　　
　　　　　h = ws1.Cells(A, 1).Value　'日付け
　　　　　i = ws1.Cells(A, 2).Value　'スケジュール
　　　　　j = Month(d)　　　　　　　 '日付から月を抜く
　　　　　k = Day(d)　　　　　　　　 '日付から日を抜く
　　　
　　　　　
　　If j = 1 Then
　　　Set rngCalendar = Worksheets(1 & " " & "月").Range("B3:H13")
　　ElseIf j = 2 Then
　　　Set rngCalendar = Worksheets(2 & " " & "月").Range("B3:H13")
　　ElseIf j = 3 Then
　　　Set rngCalendar = Worksheets(3 & " " & "月").Range("B3:H13")
　　ElseIf j = 4 Then
　　　Set rngCalendar = Worksheets(4 & " " & "月").Range("B3:H13")
　　ElseIf j = 5 Then
　　　Set rngCalendar = Worksheets(5 & " " & "月").Range("B3:H13")
　　ElseIf j = 6 Then
　　　Set rngCalendar = Worksheets(6 & " " & "月").Range("B3:H13")
　　ElseIf j = 7 Then
　　　Set rngCalendar = Worksheets(7 & " " & "月").Range("B3:H13")
　　ElseIf j = 8 Then
　　　Set rngCalendar = Worksheets(8 & " " & "月").Range("B3:H13")
　　ElseIf j = 9 Then
　　　Set rngCalendar = Worksheets(9 & " " & "月").Range("B3:H13")
　　ElseIf j = 10 Then
　　　Set rngCalendar = Worksheets(10 & " " & "月").Range("B3:H13")
　　ElseIf j = 11 Then
　　　Set rngCalendar = Worksheets(11 & " " & "月").Range("B3:H13")
　　ElseIf j = 12 Then
　　　Set rngCalendar = Worksheets(12 & " " & "月").Range("B3:H13")
　　End If

　　Set rngFound = rngCalendar.Find(k, After:=rngCalendar(1), _
　　　　　　LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
　　　　　　MatchCase:=False, MatchByte:=False, SearchFormat:=False)
　　
　　　　
　　　　If k = rngFound.Value Then
　　　　　　Call setSchedule(rngFound.Offset(1, 0), l)
　　　　
　　　　Else
　　　　　　Set rngFound = rngCalendar.FindNext(rngFound)
　　　　　　
　　　　　　If Not rngFound Is Nothing Then
　　　　　　　　
　　　　　　　　If d = rngFound.Value Then
　　　　　　　　　　Call setSchedule(rngFound.Offset(1, 0), l)
　　　
　　　　　　　　End If
　　　　　　
　　　　　　End If
　　　　
　　　　End If
　　　
　 Next A
　　　
End Sub

Function setSchedule(r As Range, l As String)
　　If r.Value = "" Then
　　　　r.Value = l
　　Else
　　　　r.Value = r.Value & vbLf & l
　　End If
End Function

End Function

24 hits

▼

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