vbaについて

Question

vba初心者です。
どなたか助けていただきたいです。。。
a列に日付(一年間)
別シートに祝日、休みの日付が入力してあります。
条件書式でその部分は塗り潰してあります。

やりたいことは
日と休みの日以外は10行ずつ挿入したいです。
また行挿入したらその10行は同じ日付になるようにしたいです。

10行まで挿入できたのですが、挿入するだけで日付をコピーされず、休みの日の行まで追加されてしまって。。。
わかる方ご教授いただきたいです。
ちなみに列は18列あります。

tatsumaru77 · Accepted Answer

以下のマクロを標準モジュールに登録してください。祝日を記述したシート名は、「祝日」にしてあります。あなたの環境に合わせて適切なシート名に変えてください。行が追加されるシートは、表示されているシート（アクティブシート）になります。そのシートを表示した状態でマクロを実行してください。（シートを直接書き換えますので、最初は念のため、シートのバックアップを取って行ってください） Option Explicit Public Sub 行挿入() Dim sh1 As Worksheet Dim sh2 As Worksheet Dim dicT As Object Dim maxrow1 As Long Dim maxrow2 As Long Dim wrow As Long Dim wdate As Variant Dim i As Long Set sh1 = ActiveSheet Set sh2 = Worksheets("祝日") Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義 maxrow1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'Sheet1 A列最終行を求める maxrow2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row 'Sheet2 A列最終行を求める '祝日を記憶する For wrow = 2 To maxrow2 dicT(sh2.Cells(wrow, "A").Value) = True Next '平日に10行挿入する For wrow = maxrow1 To 6 Step -1 wdate = sh1.Cells(wrow, 1).Value If Weekday(wdate) <> 1 And dicT.exists(wdate) = False Then sh1.Rows(wrow).Copy sh1.Rows(wrow + 1).Resize(10).Insert Shift:=xlDown End If Next Application.CutCopyMode = False '日付が異なる行に太い線を引く maxrow1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'Sheet1 A列最終行を求める wdate = "" For wrow = 6 To maxrow1 If wdate <> sh1.Cells(wrow, 1).Value Then With sh1.Range("A" & wrow & ":R" & wrow).Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium End With End If wdate = sh1.Cells(wrow, 1).Value Next '最後の行の下側を太線にする With sh1.Range("A" & maxrow1 & ":R" & maxrow1).Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium End With End Sub

ママチャリ · Answer

オートフィルで固定の数分コピーすると閏年と平年の数が合わないはずですが、その辺、問題ないのでしょうか？

条件付き書式は事前にマニュアルで設定しているのに、mm/dd(aaa)はマクロで設定しているって、何となく一貫性に欠けますね。どちらかに統一した方が良いかな？個人的には、事前に設定しておいた方がメンテしやすそうですが・・・。

1年分の日付を設定してから平日分の行を増やすって、ちょっと違和感があります。最初から、休日なら1行、平日なら10行を設定してしまった方が、分かり易そうな・・・。こんな感じで！！

Sub sample()
    Dim i As Long
    Dim d As Variant
    i = 6
    For d = DateValue("2021/04/01") To DateValue("2022/03/31")
        Cells(i, "A").Value = d
        If Cells(i, "A").DisplayFormat.Interior.Pattern = xlPatternNone Then
            Cells(i, "A").Resize(10).Value = d
            i = i + 10
        Else
            i = i + 1
        End If
    Next
End Sub

ちなみに、休日の判定は、とりあえず日付を設定してみて、条件付き書式で色が付いたら休日と見なしています。

それから、太線の件ですが、これも条件付き書式で何とかなんないですかね？
上の行と日付が変わったら罫線を引くとか！！
休日の場合、すでに「背景色を付ける」ようになっているので、その兼ね合いもあると思いますが、見やすいように工夫すれば、十分いけそうな気がします。

tatsumaru77 · Answer

補足の画像を拝見しました。
１．挿入後の画像の4月1日を見ると、4月1日が５行あります。
これは４行挿入したことになります。
挿入するのは４行でしょうか。それとも１０行でしょうか。

２．行を挿入した後、その挿入された行のA列は、同じ日付を設定していますが、
他の列（B列～R列）は空のままで良いのでしょうか。

ママチャリ · Answer

ごめんなさい。プログラムコードを見る前に回答してしまいました。
想像していたものと違うので、正直、戸惑っています。

ちなみに、プログラムコードを画像で貼ると嫌われますよ！！質問文と同じようにテキストで貼ってくださいね。

それから、条件付き書式のコードが見当たらないようですが、事前に手作業で設定済みってことでしょうか？

すいません。今日は寝ます。おやすみなさい。

ママチャリ · Answer

こんな感じでしょうか。
ただ、難点があります。条件付き書式が設定されている範囲に対して、コピペを繰り返すと、そのルールが爆発的に増えてしまいます。これは、マニュアル操作で行っても同じだと思いますが、妥協できますか？

Sub sample()
    Dim i As Long
    For i = Cells(Rows.Count, "A").End(xlUp).Row To 6 Step -1
        If Cells(i, "A").DisplayFormat.Interior.Pattern = xlPatternNone Then
            Rows(i).Copy
            Rows(i).Resize(10).Insert Shift:=xlDown
        End If
    Next i
End Sub

tatsumaru77 · Answer

レイアウトの確認です。
１．a列に日付(一年間)のシートは添付図の左側であってますか。
1行目に見出しがなく、いきなり、日付が設定されています。
それとも、１行目は見出しですか。
（B列は曜日の確認ため曜日を表示しています）

２．１０行挿入した結果は、真ん中の図ですが、あってますか。
（2021/1/2の下に１０行挿入）

３．右側の図は、祝日カレンダーです。以下のレイアウトでOKですか。
1行目は見出し行。
A列が日付
B列が祝日の名称

画像が不鮮明な場合は、下記URLを参照ください。
こちらにもアップしています。
https://gyazo.com/08cff98fc198e0abe6613a99d0239e31

ママチャリ · Answer

状況が良く分からないのですが・・・。
メインとなるシート（一年分の日付が入力されている方）と別シート（休日が入力されている方）の２シートがあるとのことですが、条件付き書式で塗り潰してあるのは、どちらのシートですか？
普通ならメインシートの方が塗り潰されているのかなと思うのですが、それで合ってますか？
それから、１０行挿入した際、コピーしたいのは日付の列のみですか？その場合、日付の列ってどこですか？A列？B列？

出来れば、画像とか貼ってもらえると理解が早いのですが、無理ですかね？
無理なら、もうちょっと頑張って、説明してください。
作成したVBAのコードを貼っちゃっても良いですよ！！

vbaについて

以下のマクロを標準モジュールに登録してください。

オートフィルで固定の数分コピーすると閏年と平年の数が合わないはずですが、その辺、問題ないのでしょうか？

補足の画像を拝見しました。

ごめんなさい。

こんな感じでしょうか。

レイアウトの確認です。

状況が良く分からないのですが・・・。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング