oka********

2022/7/1 16:52

22回答

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

VBA 歯抜けの日付に行を追加 初心者です。 添付画像のようなデータが並んでおり、歯抜けの日に行を追加したいと思っております。 （1ヶ月のデータを支店ごとに取り込むため、このような並びになります） 考えて作ってみたのですが、最初の支店の月末まで到達すると、 A列に永遠に日付が入力されてしまい、エラーを起こしてしまいます。 どこが間違えているのか、教えていただけませんでしょうか。 Dim rng As Range Dim i As Long Set rng = Sheets("Sheet1").Range("A2") i = DateSerial(Year(rng), Month(rng), 1) Do While rng <> "" If rng = "" Then Exit Do If rng <> i Then rng.EntireRow.Insert rng.Offset(-1) = i Else Set rng = rng.Offset(1) End If i = i+ 1 Loop

画像

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

ベストアンサー

0
た

2022/7/1 17:25

なかなか高度なVBAを書いているので初心者ではないような。 問題は店舗が変わった時にi変数を初期化する事をしていない点です。 あとついでに挿入した日付には店舗名も入れてあげた方がいいよねと思いました。

画像
た

2022/7/1 17:27

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
qgl********

2022/7/1 17:33

これでどうでしょうか。 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