VBA　条件を付けて行の追加

前提・実現したいこと

ある特定の条件でエクセルのシートに行を追加したいと思っています。

画像のような形で、C列にa,b,cというデータがあり、それぞれを別のシートで必ず5行分データを出力するようにして、追加された行には番号のみを振り当ててF列のデータの値には空白が入るようにしたいです。C列のデータはd,e,f...と続いていきます。

最終行からみて、C列のデータが上のデータと違うなら行を挿入すればいいのかと思ったのですが、データの数が不規則で何行入るかわからないためできませんでした。

どう考えればいいのか全く分からないので、考え方や参考になりそうなサイトがあれば教えて頂きたいです。
投げっぱなしの質問で申し訳ありません。。。

発生している問題・エラーメッセージ

エラーメッセージ

該当のソースコード

VBA
1Sub CommandButton1_Click()
2    Dim wb1 As Workbook
3    Dim awb1 As Worksheet
4    Dim wb2 As Workbook
5    Dim awb2 As Worksheet
6    Dim m As Long
7    Dim n As Long
8
9    Set wb1 = ActiveWorkbook
10    Set awb1 = wb1.Worksheets(1)
11    
12    Workbooks.Add
13    
14    Set wb2 = ActiveWorkbook
15    Set awb2 = wb2.Worksheets(1)
16    
17    awb1.Columns(2).Copy
18    awb2.Columns(2).PasteSpecial
19    
20    awb1.Columns(3).Copy
21    awb2.Columns(3).PasteSpecial
22    
23    m1 = awb1.Cells(Rows.Count, 3).End(xlUp).Row
24    n1 = awb2.Cells(Rows.Count, 3).End(xlUp).Row
25     
26    For m = 2 To n1
27        m2 = awb2.Cells(n1, 3)
28        m3 = awb2.Cells(n1 - 1, 3)
29        
30        If Not m2 = m3 Then
31            awb2.Rows(n1).Insert
32        End If
33        
34        n1 = n1 - 1
35        If n1 = 2 Then
36            Exit For
37        End If
38        
39    Next m
40    
41End Sub

試したこと

実行するとこうなります。
これを1行追加するのではなく、それぞれの項目が必ず5行になるようにしたいです。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

meg_

2019/10/07 10:58

「C列のデータが上のデータと違うなら行を挿入すればいい」←ここまでのコードを載せてください。この考えに＋αでいけるかと思います。

yama0131

2019/10/07 12:44 編集

>meg_さんつたないコードですがご確認お願いします。

meg_

2019/10/07 13:17

下記エラーが発生してコードを実行できません。・変数m1、n1、m2、m3が定義されていません

行動規範の内容に同意します

回答2件

ExcelVBA
1Sub test()
2    Dim c As Range
3    Dim aa As Range
4    Dim a As Range
5
6    '出力用シートの用意
7    With Worksheets("Sheet1")
8        .Copy after:=Worksheets(.Index)
9        Set c = .Next.Range("B2")
10    End With
11    '小計機能でキーブレーク箇所に数式を入れる
12    With c.CurrentRegion
13        .Subtotal GroupBy:=2, Function:=xlCount, TotalList:=2
14    End With
15    '数式のある行に行挿入
16    With c.CurrentRegion.Columns(2).Offset(1)
17        Set aa = .SpecialCells(xlCellTypeFormulas)
18        For Each a In aa.Areas
19            a.EntireRow.Resize(5 - a.Cells(1).Value).Insert
20        Next
21    End With
22    '空白セルを記録して、小計機能解除
23    With c.Worksheet.UsedRange
24        Set aa = .Columns(2).SpecialCells(xlCellTypeBlanks)
25        .RemoveSubtotal
26    End With
27    '連番入力
28    Application.Range(c, aa.Areas(aa.Areas.Count)).Resize(, 1).DataSeries
29End Sub

一見、コードが短くならなかったけど、VBAでのループの回数を極力減らすなら、
こんな感じ・・・
参考までに。

投稿2019/10/08 00:58

mattuwan

総合スコア2136

ベストアンサー

提示されたコードを基に修正しました。（抜粋）
※このコードでは上側に空白行ができます（下からループしているため）。
下側が良い場合は変更してください。

vba
1    count = 0
2    For m = 2 To n1
3        m2 = awb2.Cells(n1, 3)
4        If count = 0 Then
5            count = 1
6        End If
7        m3 = awb2.Cells(n1 - 1, 3)
8
9        If Not m2 = m3 Then
10            While count < 5
11                awb2.Rows(n1).Insert
12                count = count + 1
13            Wend
14            count = 0
15        Else
16            count = count + 1
17        End If
18
19        n1 = n1 - 1
20        If n1 = 2 Then
21            While count < 5
22                awb2.Rows(n1).Insert
23                count = count + 1
24            Wend
25            Exit For
26        End If
27
28    Next m