VBA 歯抜けの日付に行を追加 初心者です。 添付画像のようなデータが並んでおり、歯抜けの日に行を追加したいと思っております。

画像

Visual Basic38閲覧xmlns="http://www.w3.org/2000/svg">50

ベストアンサー

0
画像

Sub 歯抜けの日付に行を追加() Dim rng As Range Dim i As Long Dim tenpo As String Set rng = Sheets("Sheet1").Range("A2") Do While rng <> "" '店舗が変わったら初期化 If tenpo = "" Or tenpo <> rng.Offset(, 1) Then tenpo = rng.Offset(, 1) i = DateSerial(Year(rng), Month(rng), 1) End If If rng <> i Then rng.EntireRow.Insert rng.Offset(-1) = i rng.Offset(-1, 1) = tenpo Else Set rng = rng.Offset(1) End If i = i + 1 Loop End Sub

ThanksImg質問者からのお礼コメント

早速のご回答ありがとうございました! 日付だけでどうにか処理しようとしていたことが恥ずかしいです。 店舗ごとで考えるということを完全に失念しておりました。 他データがあるときはそれらのデータも利用して VBAを書けるよう精進致します! ありがとうございました。

お礼日時:7/1 17:36

その他の回答(1件)

0

これでどうでしょうか。 Sub sample() Dim i As Date, k As Integer, n As Integer Dim A, B, C A = DateSerial("2022", "6", 1) '指定月の1日 B = DateSerial("2022", "6" + 1, 0) '指定月の月末 ReDim C(1 To 31, 1 To 2) n = 2 Do k = 0 For i = A To B k = k + 1 C(k, 1) = i '日付を格納 If Cells(n, 1) = "" Then Exit Do If Cells(n, 1) = C(k, 1) Then n = n + 1 Else Rows(n).Insert n = n + 1 End If Next i Loop End Sub