• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:A列の下2桁だけが連番でなかったら1行だけを挿入するマクロは?)

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

このQ&Aのポイント
  • A列の下2桁が連番でない場合、特定の行に1行だけを挿入するマクロの作成方法を教えてください。
  • 連番が抜けている場合には、最大で4-5個のデータエリアを持つことがあります。
  • 実行前のエリア数は常に12または24または36で、連番が抜けている場合は2行を挿入してエリア数を調整します。

質問者が選んだベストアンサー

  • ベストアンサー
回答No.1

以下のマクロは抜けている部分に行を追加します。質問文に「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

oshietecho-dai
質問者

お礼

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