[[20180108093906]]　『VBAにて条件による行挿入』（ぜん）　ページの最後に飛ぶ

『VBAにて条件による行挿入』（ぜん）

こんにちは。ＶＢＡ初心者です。
下記のような所属ｺｰﾄﾞと枝番が変わるごとに空白行が挿入されている表があります。そこからＶＢＡで所属が変わるところに、もう1行空白行が挿入されるようにしたいのです。（この表では12行目と32行目）
色々調べて下記のコードを作成してみたのですが、条件に関係なく2行ずつ空白行が挿入されてしまいます・・・。
どのｺｰﾄﾞを修正したらいいのでしょうか。

　　/A 　　/B /C /D /E 　　　 /F
1 /所属ｺｰﾄﾞ/ 枝番 /工番 /氏名 /生年月日 /年齢
2 /240 /1 /1111 /aaaa /S36.12.29 /56歳0ヶ月
3 /240 /1 /1112 /bbbb /S45.4.23 /47歳8ヶ月
4
5 /240 /2 /1113 /cccc /S40.9.23 /52歳3ヶ月
6 /240 /2 /1114 /dddd /S46.7.15 /46歳5ヶ月
7 /240 /2 /1115 /eeee /S31.1.24 /61歳11ヶ月
8
9 /240 /3 /1116 /ffff /S32.2.12 /60歳10ヶ月
10/240 /3 /1117 /gggg /S32.5.1 /60歳8ヶ月
11/240 /3 /1118 /hhhh /S60.6.7 /32歳7ヶ月
12
13/223 /1 /1119 /iiii /S46.6.11 /46歳6ヶ月
14/223 /1 /1120 /jjjj /S33.1.23 /59歳11ヶ月
15/223 /1 /1121 /kkkk /S34.12.4 /58歳1ヶ月
16
17/223 /2 /1123 /llll /S39.1.1 /54歳0ヶ月
18/223 /2 /1124 /mmmm /S47.5.25 /45歳7ヶ月
19/223 /2 /1125 /nnnn /S47.8.14 /45歳4ヶ月
20
21/223 /3 /1126 /oooo /S48.8.16 /44歳4ヶ月
22/223 /3 /1127 /pppp /S60.6.3 /32歳7ヶ月
23/223 /3 /1128 /qqqq /S61.9.9 /31歳3ヶ月
24
25/223 /4 /1129 /rrrrr /S63.9.14 /29歳3ヶ月
26/223 /4 /1130 /ssss /S47.7.3 /45歳6ヶ月
27/223 /4 /1131 /tttt /H6.7.19 /23歳5ヶ月
28/223 /4 /1132 /uuuu /H6.10.4 /23歳3ヶ月
29/223 /4 /1133 /vvvv /H10.3.25 /19歳9ヶ月
30/223 /4 /1134 /wwww /S58.5.6 /34歳8ヶ月
31/223 /4 /1135 /xxxx /H10.11.1 /19歳2ヶ月
32
33/210 /1 /1136 /yyyy /S32.3.3 /60歳10ヶ月
.
.
.

Sub 平均年齢()

Dim cnt() As Long, i As Long, Lrow As Long
Lrow = Range("A" & Rows.Count).End(xlUp).Row

ReDim cnt(1 To Lrow)
r = 1
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row Step 2

If Cells(i, 1) <> "" Then

   cnt(r) = Cells(i, 1).Value

     If Cells(i + 2, 1).Value <> cnt(r) Then
     Rows(i + 1).Insert
     i = i - 1
     End If

r = r + 1

End If

Next i

End Sub

＜使用 Excel：Excel2007、使用 OS：Windows7 ＞

 一応何度か条件を変えてテストしてみましたが、間違っている箇所があったら指摘してください。

 Sub test()

     Dim i As Long

     For i = Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
         If (Cells(i, 1) <> Cells(i - 2, 1)) And Cells(i - 1, 1) = "" Then Rows(i - 1).Insert
     Next

 End Sub
（bi） 2018/01/08(月) 11:05

biさんありがとうございます。
うまくいきました！！早速活用させて頂きます。
（ぜん） 2018/01/08(月) 13:07

追加で質問させてください。
挿入した行のＦ列に所属ごとに平均年齢の関数を追加したいのですがそちらもＶＢＡで可能なのでしょうか？
（ぜん） 2018/01/08(月) 13:18

 多分合っているとは思いますが検証しきれていません。

 Sub test()

     Dim i As Long

     For i = Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
         If (Cells(i, 1) <> Cells(i - 2, 1)) And Cells(i - 1, 1) = "" Then
            Rows(i - 1).Insert
            Cells(i - 1, 6).Formula = "=DATEDIF(AVERAGEIF(A:A,A" & i - 2 & ",E:E),TODAY(),""Y"")&""歳""&DATEDIF(AVERAGEIF(A:A,A" & i - 2 & ",E:E),TODAY(),""YM"")&""ヶ月"""
         End If
     Next

 End Sub
（bi） 2018/01/09(火) 10:40

biさんありがとうございます。
何回か検証し、計算式は希望したセルに入るのですが、平均年齢の値はエラーとなってしまいます。
ｺｰﾄﾞを直してみたりもしたのですが、やはりエラーとなりお手上げです・・・。

（ぜん） 2018/01/09(火) 16:00

 こちらのテストではF12セルに52歳4ヶ月、F33セルに38歳3ヶ月と表示されエラーは出ません。
 なぜぜんさんの方でエラーが出るかはこちらではわからず力になれなくてすみません。
（bi） 2018/01/09(火) 17:14

出来ました！ただ何回か検証すると必ず最後の所属の分だけ計算されません…
なぜなのでしょうか？m(_ _)m
（ぜん） 2018/01/10(水) 12:27

コメント返信：

[ 一覧(最新更新順) ]

[[20180108093906]] 『VBAにて条件による行挿入』（ぜん） ページの最後に飛ぶ

[[20180108093906]]　『VBAにて条件による行挿入』（ぜん）　ページの最後に飛ぶ