A列の下2桁だけが連番でなかったら1行だけを挿入するマクロは？

質問

基本は、A列の下2桁 （ 各連番が複数ずつあります ） だけが連番になっているんですが、　"たまに"　　抜けている （ ない ） 時がありますので、
マクロ実行後に、連番が抜けている （ ない ） 場合に、そこに　「 1行だけ を挿入　」　して、　かつ　その行のFS列 ( 175列目 ) まで 　ハイフン　「 - 」 　を入力したいんです。
そして、必ずデータエリア数を 　 12　 or　 24　 or 　 36　 　にしたいんです （ マクロ実行前は　36　を超えることはありません ）。 　
連番が抜けている （ ない ） 場合、多くても　4・5つのデータエリア　です。
3通り　のマクロが必要のように思いますが、下記例の　1通り　をどうかご教授下さいませ。
----------------------------
**01　が　約10～19行 （ 変動します ）　まであります （ これを　エリア数1　と表現させて頂きます ）。
そして、他の　「　**02 ～ **12　」　も同様です。これで　合計エリア数12　となります。
「　**01 ～ **12　」　は、必ず昇順になっています。

下記例は、
エリア数を 実行後　24　にしたい場合の例です （ この場合、実行前は　24　を越えることはありません ）。
「　最初の　**01 ～ **12　」 のうち　「 **02 」　と　「 **12 」　が抜けている （ ない ） 場合です。　

実行前 （ エリア数22　です。「 **02 」　と　「 **12 」　が抜けている （ ない ）　）
A列
**01
・
**01
**03
・
**03
・
**11
・
**11
**01
・
**01
**02
・
**12
**12

↓↓↓
実行後 （ 挿入した2行を　エリア数2　としまして、　合計エリア数24　となります ）
A列　　　B列　　　・　　　・　　　FS列　
**01
・
**01
-　　　　　　-　　　　・　　　・　　　-
**03
・
**03
・
**11
・
**11
-　　　　　　-　　　　・　　　・　　　-
**01
・
**01
**02
・
**12
**12

回答No.1

cafe_au_lait · ベストアンサー

以下のマクロは抜けている部分に行を追加します。質問文に「1行だけ」とありましたが、連続で抜けている場合はデータエリア数を12の倍数に合わせるために、抜けた数だけ行を挿入しています。

A列の下二桁が数字でない場合はエラーとなります。

Option Explicit

Sub RowsSearch()

Dim i As Integer
Dim n(1) As Integer

i = Range("A65536").End(xlUp).Row '最終行の取得

'最後のデータエリアが抜けている場合
n(1) = CInt(Right(Cells(i, 1).Value, 2))
If n(1) <> 12 Then
Range("A" & i + 1 & ":FS" & i - n(1) + 12).Value = "-"
End If

For i = i To 2 Step -1

'該当セルと上のセルの末尾二桁を取得
n(0) = CInt(Right(Cells(i - 1, 1).Value, 2))
n(1) = CInt(Right(Cells(i, 1).Value, 2))

'末尾が同じ場合、1増えた場合(5→6など)、11減った場合(12→1)は何もしない
If n(1) = n(0) Or n(1) = n(0) + 1 Or n(1) = n(0) - 11 Then

'末尾が減った場合
ElseIf n(1) < n(0) Then
Range(i & ":" & i - n(0) + n(1) + 10).Insert Shift:=xlDown
Range("A" & i & ":FS" & i - n(0) + n(1) + 10).Value = "-"

'末尾が増えた場合
Else
Range(i & ":" & i - n(0) + n(1) - 2).Insert Shift:=xlDown
Range("A" & i & ":FS" & i - n(0) + n(1) - 2).Value = "-"

End If

Next i

'先頭のデータエリアが抜けている場合
If CInt(Right(Cells(1, 1).Value, 2)) <> 1 Then
n(1) = CInt(Right(Cells(i, 1).Value, 2))
Range(1 & ":" & n(1) - 1).Insert Shift:=xlDown
Range("A" & 1 & ":FS" & n(1) - 1).Value = "-"
End If

End Sub

お礼

雑な質問内容を、ご理解いただいて誠に有難う存じます。
まさかと思いました。
フル使用もできます。