Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
414 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【80354】カレンダーに予定を自動入力したい VBA初心者 19/1/31(木) 12:44 質問[未読]
【80356】Re:カレンダーに予定を自動入力したい γ 19/1/31(木) 20:34 発言[未読]
【80361】Re:カレンダーに予定を自動入力したい VBA初心者 19/2/1(金) 9:33 お礼[未読]
【80364】Re:カレンダーに予定を自動入力したい γ 19/2/1(金) 11:59 発言[未読]
【80369】Re:カレンダーに予定を自動入力したい γ 19/2/2(土) 13:30 発言[未読]
【80375】Re:カレンダーに予定を自動入力したい VBA初心者 19/2/5(火) 9:10 お礼[未読]
【80385】Re:カレンダーに予定を自動入力したい VBA初心者 19/2/7(木) 11:40 質問[未読]
【80397】Re:カレンダーに予定を自動入力したい マナ 19/2/10(日) 9:04 発言[未読]
【80418】Re:カレンダーに予定を自動入力したい VBA初心者 19/2/12(火) 9:28 回答[未読]
【80420】Re:カレンダーに予定を自動入力したい マナ 19/2/12(火) 19:30 発言[未読]
【80423】Re:カレンダーに予定を自動入力したい VBA初心者 19/2/13(水) 14:12 回答[未読]
【80424】Re:カレンダーに予定を自動入力したい マナ 19/2/13(水) 18:56 発言[未読]
【80428】Re:カレンダーに予定を自動入力したい VBA初心者 19/2/14(木) 10:46 回答[未読]
【80431】Re:カレンダーに予定を自動入力したい マナ 19/2/14(木) 19:16 発言[未読]
【80487】Re:カレンダーに予定を自動入力したい VBA初心者 19/2/18(月) 14:09 回答[未読]
【80493】Re:カレンダーに予定を自動入力したい マナ 19/2/18(月) 17:46 発言[未読]
【80357】Re:カレンダーに予定を自動入力したい マナ 19/1/31(木) 20:59 発言[未読]
【80360】Re:カレンダーに予定を自動入力したい マナ 19/1/31(木) 22:47 発言[未読]
【80363】Re:カレンダーに予定を自動入力したい VBA初心者 19/2/1(金) 11:48 質問[未読]
【80366】Re:カレンダーに予定を自動入力したい マナ 19/2/1(金) 22:00 発言[未読]
【80376】Re:カレンダーに予定を自動入力したい VBA初心者 19/2/5(火) 9:23 お礼[未読]
【80380】Re:カレンダーに予定を自動入力したい マナ 19/2/5(火) 19:47 発言[未読]
【80362】Re:カレンダーに予定を自動入力したい VBA初心者 19/2/1(金) 10:05 お礼[未読]
【80354】カレンダーに予定を自動入力したい
質問  VBA初心者  - 19/1/31(木) 12:44 -
引用なし
パスワード
   初めまして。メーカー系の会社に勤めていて、最近VBAを勉強し始めた者です。
エクセルの表を使って業務予定を管理しているのですが、カレンダーでも予定を管理したいと思っています。
その際にエクセルに入力した予定をそのままカレンダーに反映させることは出来ないかと考え、下のようなVBAを作ってみたのですが上手く動きません。
なぜ動かないのか教えていただきたいです。
また、「もっとこうした方がいいよ」などのアドバイス等ありましたら
宜しくお願い致します。


Sub カレンダー入力()

Dim A As Date 　‘日付
Dim B As Long　 ‘シリアル値
Dim Z As Long　 ‘行数

Dim i As Integer　‘sheet1の最終行変数

Dim myRange As Range　‘カレンダー選択範囲
Dim myObj As Range　　‘シリアル値が一致しているセル
Dim keyWord As String　‘一致しているシリアル値
Dim firstcell As Range　‘一致しているシリアル値の最初のセル
Dim Q As Range　‘一致しているシリアル値の真下のセル

For Z = 1 To i

i = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row　'sheet1の最終行数を格納


A = Worksheets("Sheet1").Cells(Z, 1).Value　‘日付を読み取る

B = CLng(A) ‘日付をシリアル値に変更
　
Set myRange = Range("E1:K10")　‘検索したいカレンダーの範囲を選択

keyWord = B　
　　
Set myObj = myRange.Find(keyWord, LookAt:=xlWhole)　‘シリアル値が一致しているセルを探す
　　
　　If Not myObj Is Nothing Then　‘一致したシリアル値が1つだけでなかった場合
　　　
　　　Set firstcell = myObj　'最初のセルを選択
　　
　　　Do
　　
　　　Set myObj = Cells.FindNext(myObj)　'次に一致したセルを選択

　　　Range(myObj).Offset(1, 0).Activate　'その真下のセルを選択
　　　
　　　Q = Range(myObj).Offset(1, 0).Activate　
　　　
　　　　　　
　　　　　　If Q = "" Then　‘真下のセルが空白だった時
　　　　　
　　　　　　Set Q = Worksheets("Sheet1").Cells(Z, 2).Value　‘sheet1の値を入れる
　　　　　　

　　　　　　Else
　　　　　　　
　　　　　　　If VarType(ActiveCell.Offset(1, 0)) = 3 Then　‘既に文字が入っていた場合
　　　　　　　　 Set Q = Worksheets("Sheet1").Cells(Z, 2).Value & vbLf & Str(Q)　
　　　　　　　
　　　　　　　Else
　　　　　　　　 Set Q = Worksheets("Sheet1").Cells(Z, 2).Value & vbLf & Str(Q)
　　　　　　　　
　　　　　　　End If
　　　　　　
　　　　　 End If
　　　
　　　　Loop While myObj.Address <> firstcell.Address

　　 End If
　　　　
Next Z　　
　　　
End Sub
【80356】Re:カレンダーに予定を自動入力したい
発言  γ  - 19/1/31(木) 20:34 -
引用なし
パスワード
   コードだけではなく、
・現在のシートのレイアウト（行番号、列番号がわかるもの）と
・どういうことを実行したいのかを
説明するのが先でしょう。

あなたの頭にあることを、
間違っているコードで想像するのは大変です。
【80357】Re:カレンダーに予定を自動入力したい
発言  マナ  - 19/1/31(木) 20:59 -
引用なし
パスワード
   ▼VBA初心者 さん：

１）カレンダーなのに、日付検索で複数ヒットする可能性がありますか。
Do〜Loopは必要ないのでは？
ということです。

２）シリアル値に変換する必要ありますか。
というか、検索できますか？

３）文法が間違っている
>Range(myObj).Offset(1, 0).Activate
>Q = Range(myObj).Offset(1, 0).Activate
>Set Q = Worksheets("Sheet1").Cells(Z, 2).Value

４）変数名がわかりにくいです（人のこと言えませんが…）

　
【80360】Re:カレンダーに予定を自動入力したい
発言  マナ  - 19/1/31(木) 22:47 -
引用なし
パスワード
   ▼VBA初心者 さん：

こんな感じのことでしょうか

Option Explicit

Sub カレンダー入力()
　　Dim rngカレンダー As Range
　　Dim rng予定表 As Range
　　Dim c As Range
　　Dim rng検索 As Range
　　Dim 業務 As String
　　
　　Set rngカレンダー = Worksheets("Sheet2").Range("E1:K10")
　　Set rng予定表 = Worksheets("Sheet1").Range("A1").CurrentRegion
　　
　　For Each c In rng予定表.Columns(1).Cells

　　　　Set rng検索 = rngカレンダー.Find(c.Value, LookAt:=xlWhole)
　　　　
　　　　If Not rng検索 Is Nothing Then
　　　　　　With rng検索.Offset(1, 0)
　　　　　　　　業務 = WorksheetFunction.Trim(c.Offset(0, 1).Value & " " & .Value)
　　　　　　　　.Value = Join(Split(業務), vbLf)
　　　　　　End With
　　　　End If
　　　　
　　Next c
　　
End Sub


　
【80361】Re:カレンダーに予定を自動入力したい
お礼  VBA初心者  - 19/2/1(金) 9:33 -
引用なし
パスワード
   ▼γ さん：
>コードだけではなく、
>・現在のシートのレイアウト（行番号、列番号がわかるもの）と
>・どういうことを実行したいのかを
>説明するのが先でしょう。
>
>あなたの頭にあることを、
>間違っているコードで想像するのは大変です。

γ様

お返事ありがとうございます。
無知で大変申し訳ありません。

現在のシートレイアウトは、

・A列に自分が入力した日付
・B列に自分が入力した文字列
・E1〜K10までにエクセルのテンプレートにあるカレンダー(1月分)を引用したもの（日付の下に空白セルがありメモが取れるようになっています）


私がやりたいことは、

B列に入力した文字列をA列に入力した日付と同じ日付のカレンダーのメモ欄に自動で入力してほしいということです。

また現在は1月分だけですが、最終的にはシートを分けて1月〜12月までのカレンダーに自動入力できるようにしたいです。


宜しくお願い致します。
【80362】Re:カレンダーに予定を自動入力したい
お礼  VBA初心者  - 19/2/1(金) 10:05 -
引用なし
パスワード
   ▼マナ さん：
>▼VBA初心者 さん：
>
>１）カレンダーなのに、日付検索で複数ヒットする可能性がありますか。
>Do〜Loopは必要ないのでは？
>ということです。
>
>２）シリアル値に変換する必要ありますか。
>というか、検索できますか？
>
>３）文法が間違っている
>>Range(myObj).Offset(1, 0).Activate
>>Q = Range(myObj).Offset(1, 0).Activate
>>Set Q = Worksheets("Sheet1").Cells(Z, 2).Value
>
>４）変数名がわかりにくいです（人のこと言えませんが…）
>
>　

マナ様

お返事ありがとうございます。

上記内容に関して返答させていただきます。

1)カレンダーなのに、日付検索で複数ヒットする可能性がありますか。
Do〜Loopは必要ないのでは？ということです。

→エクセルのカレンダーのテンプレート(1月〜12月でsheetが分けられて表示されるもの)を使っています。sheetは行に5週分の日数、列に日曜〜土曜の曜日が入力されています。その中で、2019年1月のsheetは31日が木曜日なので、残りの金曜日と土曜日の枠には2月1,2日が入力されています。その中で全部のsheetを参照すると重複する箇所が出てくるのでDo〜Loopを使用してみました。


2)シリアル値に変換する必要ありますか。というか、検索できますか？

→自分が入力した日付をそのままカレンダーで検索することが出来なかった（私が無知だということが原因です・・・。）のでシリアル値なら検索できるかなと考え、一度日付を変更して検索するという手段をとりました。
検索は出来ていると思います。


3)文法の指摘、ありがとうございます。


4)大変申し訳ありません。自分だけが今何をやっているのか理解できるようにつけていたので、混乱させてしまいました。
【80363】Re:カレンダーに予定を自動入力したい
質問  VBA初心者  - 19/2/1(金) 11:48 -
引用なし
パスワード
   ▼マナ さん：
>▼VBA初心者 さん：
>
>こんな感じのことでしょうか
>
>Option Explicit
>
>Sub カレンダー入力()
>　　Dim rngカレンダー As Range
>　　Dim rng予定表 As Range
>　　Dim c As Range
>　　Dim rng検索 As Range
>　　Dim 業務 As String
>　　
>　　Set rngカレンダー = Worksheets("Sheet2").Range("E1:K10")
>　　Set rng予定表 = Worksheets("Sheet1").Range("A1").CurrentRegion
>　　
>　　For Each c In rng予定表.Columns(1).Cells
>
>　　　　Set rng検索 = rngカレンダー.Find(c.Value, LookAt:=xlWhole)
>　　　　
>　　　　If Not rng検索 Is Nothing Then
>　　　　　　With rng検索.Offset(1, 0)
>　　　　　　　　業務 = WorksheetFunction.Trim(c.Offset(0, 1).Value & " " & .Value)
>　　　　　　　　.Value = Join(Split(業務), vbLf)
>　　　　　　End With
>　　　　End If
>　　　　
>　　Next c
>　　
>End Sub
>
>
>　
マナ様

先のご返答に引き続きありがとうございます。
とても参考になります。

追加でご質問させていただいてもよろしいでしょうか？

Set rngカレンダー = Worksheets("Sheet2").Range("E1:K10")
Set rng予定表 = Worksheets("Sheet1").Range("A1").CurrentRegion

↑の部分で

rngカレンダーをworksheet2(1月)〜worksheet13(12月)までの.range("A1:H14)までにしたい場合は
Set rngカレンダー = Worksheets(Array("1月", "2月", "3月", "4月", "5月", "6月", "7月", "8月", "9月", "10月", "11月", "12月").range("A1:H14")

で合っていますか？
【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
【80366】Re:カレンダーに予定を自動入力したい
発言  マナ  - 19/2/1(金) 22:00 -
引用なし
パスワード
   ▼VBA初心者 さん：

>追加でご質問させていただいてもよろしいでしょうか？

そのまえに、わたしの提示したマクロでは検索できていませんよね。
それでもよいのですか？
【80369】Re:カレンダーに予定を自動入力したい
発言  γ  - 19/2/2(土) 13:30 -
引用なし
パスワード
   ああ、そうでしたか、
質問者さんの「できない」を信用してしまったのですが、
LookIn:=xlValuesをLookIn:=xlFormulas　にすれば
日ではなくそんままの値を検索値にして、
ユニークに特定でき、二度調べる必要はなかったのですね。
不覚・・・。
【80375】Re:カレンダーに予定を自動入力したい
お礼  VBA初心者  - 19/2/5(火) 9:10 -
引用なし
パスワード
   ▼γ さん：
>ああ、そうでしたか、
>質問者さんの「できない」を信用してしまったのですが、
>LookIn:=xlValuesをLookIn:=xlFormulas　にすれば
>日ではなくそんままの値を検索値にして、
>ユニークに特定でき、二度調べる必要はなかったのですね。
>不覚・・・。
>

γ様
お返事ありがとうございます。
教えていただいたことを参考に、自分でもう一度調べながらやってみようと思います！
本当にありがとうございました！
【80376】Re:カレンダーに予定を自動入力したい
お礼  VBA初心者  - 19/2/5(火) 9:23 -
引用なし
パスワード
   ▼マナ さん：
>▼VBA初心者 さん：
>
>>追加でご質問させていただいてもよろしいでしょうか？
>
>そのまえに、わたしの提示したマクロでは検索できていませんよね。
>それでもよいのですか？

マナ様

お返事ありがとうございます。
Set rng検索 = rngカレンダー.Find(c.Value, LookAt:=xlWhole)
　　　　
　　　　If Not rng検索 Is Nothing Then
　　　　　　With rng検索.Offset(1, 0)
　　　　　　　　業務 = WorksheetFunction.Trim(c.Offset(0, 1).Value & " " & .Value)

↑の部分で検索していると思っていましたが、違いますでしょうか・・・？
【80380】Re:カレンダーに予定を自動入力したい
発言  マナ  - 19/2/5(火) 19:47 -
引用なし
パスワード
   ▼VBA初心者 さん：

>↑の部分で検索していると思っていましたが、違いますでしょうか・・・？

そうなのですが、検索できなかったはずでは？
今は検索できていても、いつかまた検索できないとなる場合もあるはずです。
そのときは、γさんの回答を参考にしてください。
実際に経験すると理解できるかと思いますので
わたしからは修正案は提示しません。

-----
で、複数シートの検索の件ですが、
日付から、何月のシートを検索すればよいかわかるはずです。
すべてシートを検索する必要はないという意味です。


　
【80385】Re:カレンダーに予定を自動入力したい
質問  VBA初心者  - 19/2/7(木) 11:40 -
引用なし
パスワード
   ▼γ さん：
>カレンダには日付データが、日を表示するだけの形式でセットされているとの前提です。
>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を使えばいいと思い、何度か組んでみたのですがすべてエラーになってしまうので、教えていただきたいです。
【80397】Re:カレンダーに予定を自動入力したい
発言  マナ  - 19/2/10(日) 9:04 -
引用なし
パスワード
   ▼VBA初心者 さん：

>原因として考えられるのは、検索した結果(rngFound)がdと一つも当てはまらなかった場合の処理が入っていないということかなと思うのですが、その場合どうすればいいでしょうか？
>
>自分としてはIf Not rngFound Is Nothing Thenを使えばいいと思い、何度か組んでみたのですがすべてエラーになってしまうので、教えていただきたいです。

最初の検索の直後に挿入するのでは？
どのように試したのか提示してください。
【80418】Re:カレンダーに予定を自動入力したい
回答  VBA初心者  - 19/2/12(火) 9:28 -
引用なし
パスワード
   ▼マナ さん：
>▼VBA初心者 さん：
>
>>原因として考えられるのは、検索した結果(rngFound)がdと一つも当てはまらなかった場合の処理が入っていないということかなと思うのですが、その場合どうすればいいでしょうか？
>>
>>自分としてはIf Not rngFound Is Nothing Thenを使えばいいと思い、何度か組んでみたのですがすべてエラーになってしまうので、教えていただきたいです。
>
>最初の検索の直後に挿入するのでは？
>どのように試したのか提示してください。


マナ様

いつもお世話になっております。

Worksheet("Sheet1")に日付とスケジュール
Worksheet(1月〜12月)にカレンダーを表示させてあります。


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
　　
　　
　　For j = 1 To 12

　　Set ws1 = Worksheets("Sheet1")
　　Set ws2 = Worksheets(j & " " & "月")
　　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
　　　
　　Next j
　　
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
【80420】Re:カレンダーに予定を自動入力したい
発言  マナ  - 19/2/12(火) 19:30 -
引用なし
パスワード
   ▼VBA初心者 さん：

>Worksheet(1月〜12月)にカレンダーを表示させてあります。

まず、１月のシートだけで、ちゃんと動くものにしてください。
【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


これです！
【80424】Re:カレンダーに予定を自動入力したい
発言  マナ  - 19/2/13(水) 18:56 -
引用なし
パスワード
   ▼VBA初心者 さん：

sheet1のA列とカレンダーの日付は
それぞれ、どんなデータなのでしょう？

１例ずつで構いませんので、例示お願いします。
【80428】Re:カレンダーに予定を自動入力したい
回答  VBA初心者  - 19/2/14(木) 10:46 -
引用なし
パスワード
   ▼マナ さん：
>▼VBA初心者 さん：
>
>sheet1のA列とカレンダーの日付は
>それぞれ、どんなデータなのでしょう？
>
>１例ずつで構いませんので、例示お願いします。

sheet1の

A列には
2019/1/25
2019/1/8
2019/1/25
2019/1/1

B列にはすべて
SAMPLE

と打ち込んでいます。

カレンダーには
エクセルの年カレンダー(1つのタブで１か月)というものを使っております。
表示されている日数は日付のみです。

宜しくお願い致します。
【80431】Re:カレンダーに予定を自動入力したい
発言  マナ  - 19/2/14(木) 19:16 -
引用なし
パスワード
   ▼VBA初心者 さん：

>カレンダーには
>エクセルの年カレンダー(1つのタブで１か月)というものを使っております。
>表示されている日数は日付のみです。


γさんの回答のように、Day(d)で検索しなくて大丈夫？
本当に、シリアル値 CLng(d)で検索ができていますか。
【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
【80493】Re:カレンダーに予定を自動入力したい
発言  マナ  - 19/2/18(月) 17:46 -
引用なし
パスワード
   ▼VBA初心者 さん：

申し訳ありませんが１月だけのコードで議論させていただけませんか。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
414 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free