『マクロで日付の足りない行を補填したい』（さくら） 初めまして。 リストの日付が飛んでいる箇所に行を挿入したいのですが、うまくいきません。 ご教授頂ければ幸いです。 2つのリストがあります。日付シートと日付２シート ＜日付シート＞ 日付 記号 2022年3月20日 A 2022年3月20日 B 2022年3月22日 A 2022年3月22日 B 2022年3月25日 A 2022年3月25日 B 2022年3月25日 A ＜日付2シート＞ 日付 記号 2022年3月17日 A 2022年3月18日 A 2022年3月18日 A 日付シートのA2セルから日付が並んでいますが、3月21日、3月23日、3月24日が抜けています。 そこを行を挿入して補填する所までは出来たのですが、 息詰まっているのは、下記2点です。 1. 日付2シートの一番最後の日付（3月18日）と日付シートの先頭の日付（3月20日）を比べて日付が飛んでいたら、そこも日付シートの先頭に行を挿入したい（3月19日を挿入したい） 2. 日付シートの最後は3月25日で終わっていますが、そこを前日までの日付が抜けていたら更に行を追加したい。例：本日は3月27日なので、前日の3月26日まで日付を追加したい。 ＜Outputはこうしたい↓↓＞ 日付 記号 2022年3月19日 2022年3月20日 A 2022年3月20日 B 2022年3月21日 2022年3月22日 A 2022年3月22日 B 2022年3月23日 2022年3月24日 2022年3月25日 A 2022年3月25日 B 2022年3月25日 A 2022年3月26日 ＜考えたコード：抜けているコードを補填する部分のみ＞ Sub 挿入() Range("A2").Activate Do While IsEmpty(ActiveCell.Value) = False ActiveCell.Offset(1, 0).Select If ActiveCell.Offset(-1, 0) > ActiveCell Then Exit Sub If ActiveCell.Offset(-1, 0) + 1 < ActiveCell Then ActiveCell.EntireRow.Insert ActiveCell = ActiveCell.Offset(-1, 0) + 1 End If Loop End Sub 例えば、1の問題は、日付2シートの一番最終行の値をまず日付シートの2行目に挿入して、その状態で上記コードを走らせ、その後2行目を削除する？？ 等考えましたが、何かうまい方法が見つかりません。 また、2の問題は、上記コードとは切り離して考える必要がありますでしょうか。=TODAY()-1関数を使用するとか？？ 宜しくお願いいたします。 ＜ 使用 Excel：Office365、使用 OS：Windows10 ＞ ---- スタート日から昨日までのループで、 その日が抜けていたら、データの最終行にそれを追記し、 ループ終了後に、全体を日付でソートしたらどうですか？ （γ） 2022/03/27(日) 12:56 ---- γ様 ありがとうございます。 アドバイス頂いた方法で検討中ですが、知識が全然足らず日付をループするとはどういう方法かが分かりません。 下記のコードを考えてみましたが、 For 日付 = Start To Last部分で型が違いますのエラーとなります。 他にもおかしな所が沢山あるかと思いますが、型が違いますと始めに出て止まってしまい他の検証が出来ていません…(*_*; 日付をループで、かつ、iもループで見ていくだけではダメな気がしています。 Countif等を加えて、一度もその日付が登場していなければ…みたいな工程をいれないとダメでしょうか。。 また、年月等も　DateSerial(Year,Month,Day)等で拾わないと、日付のループで1日ずつ増えていかないでしょうか。。 勉強不足で質問がまとまっておらず、すみません。。 Sub 挿入2() Dim Start As String Dim Last As String Dim i As Long, 日付 As String Dim LastRow As Long Start = Sheets("日付2").Cells(Rows.Count, 1).End(xlUp).Value + 1 Last = "=TODAY()-1" For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row For 日付 = Start To Last With Sheets("日付") If Cells(i, 1).Value <> 日付 Then LastRow = Sheets("日付").Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(LastRow, 1) = 日付 End If End With Next 日付 Next i End Sub （さくら） 2022/03/27(日) 17:09 ---- 参考に Sub Test() Dim sDay As Date, eDay As Date, d As Date Dim myR As Variant sDay = DateAdd("d", 1, Worksheets("日付2").Cells(Rows.Count, "A").End(xlUp).Value) eDay = DateAdd("d", -1, Date) With Worksheets("日付") For d = sDay To eDay If IsError(Application.Match(CLng(d), .Columns(1), 0)) Then With .Cells(Rows.Count, "A").End(xlUp).Offset(1) .NumberFormatLocal = "yyyy""年""m""月""d""日""" .Value = d End With End If Next .Range("A1").CurrentRegion.Sort _ Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes End With End Sub （ピンク） 2022/03/27(日) 18:20 ---- ピンク様 ありがとうございます。 型の使い方、日付変換が必要な事、各行はループではなく全体をMatchで比較する事…など、大変勉強になります。 すみません、2点ほど質問させてください。 1. CLng関数を使用しているのはなぜか。日付には時間まで含まれるから整数に丸めている？ 2. myR をVariant型で変数を宣言していますが、myRはどこにも登場しないようですが、どのような意味を持つのでしょうか。 よろしくお願いいたします。 （さくら） 2022/03/27(日) 20:13 ---- >1. CLng関数を使用しているのはなぜか。 MatCh関数を使って日付の検索を行う場合、シリアル値に直す必要があるためです。 https://tech-paclab.com/searchtoday/ >2. myR をVariant型で変数を宣言していますが だだのゴミです。消し忘れていました。 （ピンク） 2022/03/27(日) 20:32 ---- >2. myR をVariant型で変数を宣言していますが Match関数で日付を検索する場合 Dim myR As Variant myR = Application.Match(CLng(d), .Columns(1), 0) この様に使います。 見つかれば myRに行番号が入り。無ければmyRにエラー値が入ります。 この様にmyRには数値、エラー値 何れも格納できるように型はVariantにしております。 myR = Application.Match(CLng(d), .Columns(1), 0) If IsError(myR) Then 無い場合の処理 Else 見つかった時の処理 End if 今回の場合、行番号は必要なく、有無の判断で良いのでmyRを省き If IsError(Application.Match(CLng(d), .Columns(1), 0)) Then となった次第です。(*^_^*) （ピンク） 2022/03/27(日) 21:08 ---- ピンク様 ご丁寧なご回答、大変ありがとうございました。 理解しました＆今後の勉強の参考になりました！！ γ様 アドバイスいただいた事で、沢山の気付きがありました。 ありがとうございました！！ （さくら） 2022/03/27(日) 21:26 ---- 先日質問させて頂いたものです。 その後更なる疑問が出てきたので、すみませんが教えて下さい。 もし、日付に時間まで入っていた場合の対応なのですが。例：2022/3/20 12:00:00 同じ日付でも時間違いのものがある場合、matchで比較すると当然エラーになるので、時間を日付のみに変更する作業が必要になってくると思いますが、 ピンク様のコードを参考に、自分なりに下記のように改良してみました。 Sub Test5() Dim sDay As Date, eDay As Date, d As Date '★↓↓ここを追加↓↓★ With Worksheets("日付2") a = Format(.Cells(Rows.Count, "A").End(xlUp).Value, "yyyy/mm/dd") b = CDate(a) End With '★↑↑ここを追加↑↑★ sDay = DateAdd("d", 1, b) '←★ここを変更★ eDay = DateAdd("d", -1, Date) With Worksheets("日付") '★↓↓ここを追加↓↓★ Dim 作業列LastRow As Long 作業列LastRow = Cells(Rows.Count, "A").End(xlUp).Row .Range(.Cells(2, "C"), .Cells(作業列LastRow, "C")).Formula = "=DATEVALUE(TEXT(A2,""yyyy年m月d日""))" '★↑↑ここを追加↑↑★ For d = sDay To eDay If IsError(Application.Match(CLng(d), .Columns(3), 0)) Then With .Cells(Rows.Count, "A").End(xlUp).Offset(1) .NumberFormatLocal = "yyyy""年""m""月""d""日""" .Value = d End With End If Next .Range("A1").CurrentRegion.Sort _ Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes .Columns(3).Delete ' ←★ここを追加★ 上記で正しい結果とはなりました。 ただ、考える過程で、今回はC列に作業列を作り日付に変換してからmatchで見比べる方法としましたが、作業列を作らなくても出来たりしますか？例えば下記の.Columns(3)の部分に Format関数とCDate関数を組み合わせればいくのではないかと試みたもののダメでした。 If IsError(Application.Match(CLng(d), .Columns(3), 0)) Then 何か良いやり方がありましたら教えて下さい。 また、追加の質問になってしまいますが、更に、飛んでいて補填した日付が日曜日だったら×、それ以外なら〇とB列に付けたいのですが、下記のコードとしましたが、これも再度範囲を取り直してループで計算式を追加する方法しか分かりませんでしたが、 matchで見る部分の工程と組み合わせたりすることは可能なものでしょうか？？ '★↓↓ここからは新しい追加作業↓↓★ Dim LastRow再取得 As Long, 再取得範囲 As Long LastRow再取得 = .Cells(.Rows.Count, "A").End(xlUp).Row For 再取得範囲 = 2 To LastRow再取得 If .Cells(再取得範囲, 2) = "" Then .Cells(再取得範囲, "B").Formula = "=IF(Weekday(A" & 再取得範囲 & ")=1,""×"",""〇"")" End If Next End With End Sub （さくら） 2022/04/02(土) 09:17 ---- Match関数では無理っぽいのでループで回してみました。 Sub Test2() Dim sDay As Date, eDay As Date, d As Date Dim myR As Variant, LastRow As Long, i As Long, flg As Boolean sDay = CLng(DateAdd("d", 1, Worksheets("日付2").Cells(Rows.Count, "A").End(xlUp).Value)) eDay = DateAdd("d", -1, Date) With Worksheets("日付") LastRow = .Cells(Rows.Count, "A").End(xlUp).Row For d = sDay To eDay For i = 2 To LastRow If d = CDate(Int(.Cells(i, "A").Value)) Then flg = True Exit For End If Next If flg = False Then With .Cells(Rows.Count, "A").End(xlUp).Offset(1) .NumberFormatLocal = "yyyy""年""m""月""d""日""" .Value = d .Offset(, 1).Value = IIf(Weekday(d) = 1, "×", "○") End With End If flg = False Next .Range("A1").CurrentRegion.Sort _ Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes End With End Sub （ピンク） 2022/04/02(土) 10:50 ---- >日付が日曜日だったら×、それ以外なら〇とB列に付けたい 全ての行に付けるのですね If flg = False Then With .Cells(Rows.Count, "A").End(xlUp).Offset(1) .NumberFormatLocal = "yyyy""年""m""月""d""日""" .Value = d ' .Offset(, 1).Value = IIf(Weekday(d) = 1, "×", "○") End With End If flg = False Next .Range("A1").CurrentRegion.Sort _ Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes .Range("B2:B" & .Cells(Rows.Count, "A").End(xlUp).Row).FormulaR1C1 = "=IF(WEEKDAY(RC[-1])=1,""×"",""○"")" End With End Sub （ピンク） 2022/04/02(土) 11:08 ---- >For 再取得範囲 = 2 To LastRow再取得 > If .Cells(再取得範囲, 2) = "" Then これを見る限り追加した行だけでしたね なら If flg = False Then With .Cells(Rows.Count, "A").End(xlUp).Offset(1) .NumberFormatLocal = "yyyy""年""m""月""d""日""" .Value = d .Offset(, 1).Value = IIf(Weekday(d) = 1, "×", "○") End With （ピンク） 2022/04/02(土) 11:18 ---- 空白は追加した行だけとは限らないのなら ' .Offset(, 1).Value = IIf(Weekday(d) = 1, "×", "○") End With End If flg = False Next .Range("A1").CurrentRegion.Sort _ Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes With .Range("B2:B" & .Cells(Rows.Count, "A").End(xlUp).Row) .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=IF(WEEKDAY(RC[-1])=1,""×"",""○"")" End With End With End Sub （ピンク） 2022/04/02(土) 11:37 ---- Sub test() Const f As String = "=QUOTIENT(XXXX,1)" Dim rngOld As Range Dim rngTemp As Range Dim dtmStart As Date Dim dtmEnd As Date With ThisWorkbook.Worksheets("日付").Range("A1").CurrentRegion Set rngOld = Intersect(.Offset(0, 0), .Offset(1, 0), .Columns(1)) End With Set rngTemp = rngOld.Offset(, 5) With rngTemp .Formula = Replace(f, "XXXX", rngOld.Cells(1).Address(False, False)) .EntireColumn.NumberFormatLocal = rngOld(1).NumberFormatLocal End With With WorksheetFunction dtmStart = .Max(ThisWorkbook.Worksheets("日付2").Range("A:A")) \ 1 + 1 dtmEnd = .Max(rngTemp) \ 1 End With With rngTemp(rngTemp.Rows.Count + 1, 1).Resize(dtmEnd - dtmStart + 1) .Cells(1).Value = dtmStart .DataSeries Date:=xlDay, Step:=1, Stop:=dtmEnd End With With rngTemp.CurrentRegion .RemoveDuplicates Columns:=1, Header:=xlNo .SpecialCells(xlCellTypeConstants).Copy End With rngOld(rngOld.Rows.Count + 1, 1).PasteSpecial rngTemp.CurrentRegion.ClearContents rngOld.CurrentRegion.Sort rngOld, xlAscending, , , , , , xlYes End Sub 頭の体操＾＾； 意外と長くなった＾＾； 参考になれば。 （まっつわん） 2022/04/02(土) 13:19 ---- ピンク様 先日に引き続き、大変ありがとうございます。 やはりmatchだと無理っぽいのですね。 CDate(Int(　〜　の発想や、ループの考え方等、大変勉強になりました。 また、曜日で〇×を付ける部分についても、色々なパターンのコードのご提示ありがとうございます。 一番始めに書いて下さったコードがやりたい事に合致していますので、参考にさせて頂きます。 大変ありがとうございました。 まっつわん様 ありがとうございます。 今読み解いているのですが、使用したことのないテクニックが色々ありこちらも勉強になります。 まずは理解できるように頑張ってみたいと思います。 ありがとうございました。 （さくら） 2022/04/02(土) 17:01 ---- >CDate(Int(　〜　の発想や、 If d = CDate(Int(.Cells(i, "A").Value)) Then ↓ If d = DateValue(.Cells(i, "A").Value) Then お恥ずかしい DateValueでイケました。(*^_^*) （ピンク） 2022/04/02(土) 18:38 ---- ピンク様 ありがとうございます。 どちらでも同じ結果になるのですね！ 色々、引き出しが増えて良かったです(*^^*) ご親切に大変ありがとうございます！ （さくら） 2022/04/02(土) 18:53 ---- 度々の質問、失礼します。 ピンク様に教えて頂いたコードの下記部分で、 sDay ＝CLng(DateAdd("d", 1, Worksheets("日付2").Cells(Rows.Count, "A").End(xlUp).Value)) 時間まで入っている場合、なぜか　＋２日の日付になってしまいます、、^_^; 2022/3/24 20:15:00.だとすると、2022/3/26が返る。 2022/3/24 の日付までのデータだと、ちゃんと2022/3/25が返る。 なので、DateAddを省き、 sDay ＝CLng(Worksheets("日付2").Cells(Rows.Count, "A").End(xlUp).Value)としました。 でも、これは時間によって返る値が違ったりして危険なのでしょうか？ 色々やっていたら分からなくなってしまい、分かる方いらっしゃいましたら、すみません教えて下さい。 （さくら） 2022/04/04(月) 20:52 ---- CLngは端数を四捨五入するからでしょうね。(CIntも同じ端数処理なので不可） 　 (1)VBAのInt関数 で切り捨てる。（ただし、これだとDateが返り、整数型にしたいのであれば不向きかも？） (2)ワークシート関数の 　Floorないし、Quotientを使って切り捨てると、整数がもどるのではないですか？ 試してみてください。 （γ） 2022/04/04(月) 22:25 ---- >sDay ＝CLng(DateAdd("d", 1, Worksheets("日付2").Cells(Rows.Count, "A").End(xlUp).Value)) >時間まで入っている場合、なぜか　＋２日の日付になってしまいます、、^_^; If d = DateValue(.Cells(i, "A").Value) Then に修正した時、見落としていました。m(_ _)m sDay ＝ DateValue(DateAdd("d", 1, Worksheets("日付2").Cells(Rows.Count, "A").End(xlUp).Value)) で如何ですか （ピンク） 2022/04/04(月) 22:47 ---- γ様、ピンク様 アドバイス頂き、ありがとうございます！ 今手元にパソコンがない為、明日それぞれどの値が返るのか、デバッグで確認してみます。 >If d = DateValue(.Cells(i, "A").Value) Thenに見直した時… ↑今日試した時に、ここでエラーになってしまったので、 Cdate(Int(.Cells(i, "A").Value) Then に戻したのですが、 sDay ＝ DateValue(DateAdd("d", 1, Worksheets("日付2").Cells(Rows.Count, "A").End(xlUp).Value))にすれば エラーにならなかったのでしょうか？ 日付は奥が深いのですね、、色々やってみたいと思います。 また、ネットでCDbl関数で倍精度浮動小数に変換してから、Int関数で整数部分のみを取得という方法も見つけたので、これも試してみたいと思います。 Int(CDbl(〜)) ご丁寧に、ほんとどうもありがとうございます。 （さくら） 2022/04/04(月) 23:00