任意の整数まで欠番行を挿入するマクロは？

質問

エクセルのSheet1のＡ列の１行目から下の行へ１から１０００まで数字（整数）が入っているとします。ただし、欠番があります。そこで、欠番を挿入して行を増やしたいのですが、すべての整数を挿入するには以下のマクロで解決しているのですが、任意の整数（下二桁が同じ整数）まで挿入したら次の桁へ飛んで、また同じ任意の整数（下二桁が同じ整数）まで来たら次の桁へ飛んでという具合に、これらを繰り返したいのです。例えば、１から４６まで、１００から１４６まで、２００から２４６まで、３００から３４６までという具合です。どなたかご教授よろしくお願いします。

Sub 欠番挿入()

Dim i As Integer

i = 0
Do Until ActiveSheet.Range("a2").Offset(i, 0).Value = ""

ActiveSheet.Range("a2").Offset(i, 0).Activate

If ActiveCell.Value <> ActiveCell.Row Then
Rows(ActiveCell.Row).Insert
ActiveSheet.Range("a2").Offset(i, 0).Value _
= ActiveCell.Row
End If

i = i + 1
Loop

End Sub

回答No.4

kmetu · ベストアンサー

> １００までは４９までの欠番が挿入され、１００以上は何も変化がありませんでした。

質問では46まででしたし、テストが甘かったみたいで、ちゃんと動かなかったですね。
以下のように変更してみてください。

Sub 欠番挿入()

Dim i As Integer, myAnyValue As Integer

myAnyValue = 46

For i = 0 To 999
If ActiveSheet.Range("a1").Offset(i, 0).Value = "" Then
Exit Sub
End If
ActiveSheet.Range("a1").Offset(i, 0).Activate
If i <> 0 Then
If ActiveCell.Value - ActiveCell.Offset(-1, 0) <> 1 _
And ActiveCell.Offset(-1, 0).Value < myAnyValue Then
Rows(ActiveCell.Row).Insert
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
End If
End If
If i = myAnyValue Then
myAnyValue = myAnyValue + 100
i = Int(myAnyValue / 100) * 100 - 1
End If
Next

End Sub

お礼

本当にいろいろと対応していただき感謝申し上げます。Ａ列に連番を入れて試しましたが、やはり１００以上の数字に関しては欠番が挿入されませんでした。このコードをもとに解決策を探ってみたいと思います。本当にありがとうございました。

補足

今回も早々のご回答ありがとうございます。私の説明の仕方が悪かったようで、、、すみません。いただいたコードは１から４６までの欠番はうまく挿入されました。私のやりたかったのは、１から４６まで挿入したら、次は１００から１４６まで、次は２００から２４６まで、次は３００から３４６までという具合に、Ａ列の最後の行まで入っている数字（およそ１０００まで）について、次の「くらい」に飛んで下２桁が４６になるように欠番を挿入するものです。もし可能であればご提示いただけませんか。よろしくお願い申し上げます。

回答No.9

kmetu

> 何か改善策はありますか。

こちらでは正常に動くので　こちらでは手の加えようがありません。
そんなに難解なコードではありませんから
ご自身でコードの流れをつかんでいただいて
どうして100以上でできないのかはご自身で改善してください。

いちど単純なA列だけの連番を作成したファイルを作成してテストしてみてもいいでしょう。

回答No.8

kmetu

> ＞100から146までの欠番はすべて146に
> 200から246までの欠番はすべて246に
> ということでしょうか？
>
> そのとおりです。可能ですか。よろしくお願い申し上げます。

そのとおりと書いていますが、あなたはこの文章をどう理解したのか聞かせてもらえますか。
すべて146すべて246と書いているのにどう理解したのでしょうか？

その前に

> 次の「くらい」に飛んで下２桁が４６になるように欠番を挿入するものです

下2桁が46になるようにと書いているのはあなた自身ですよ。
日本語ちゃんと理解してちゃんと日本語を書いてください。

また、

> ４６という行がやたら多く挿入されました。

46という行ですか、100の位はなかったんですか？
そのように作った覚えはありませんが
あなたのエクセルどこかおかしいんじゃないですか？

回答No.7

kmetu

> 行いたいのは１，２，３，４…４３，４４，４５，４６までの整数行を挿入、
> １０１，１０２，１０３，１０４…１４３，１４４，１４５，１４６までの整数行を挿入、
> ２０１，２０２，２０３，２０４…２４３，２４４，２４５，２４６までの整数行を挿入、
> ３０１，３０２，３０３，３０４…３４３，３４４，３４５，３４６までの整数行を挿入

No4のコードでそうなるはずなのですが…No4を試してみてできないと言ってるんですよね。

x46以降の連番についてはなにもしないということで
たとえば　346以降　347,350,351と飛び番があっても無視してそのままです。

補足

何度もすみません。ネットだどうまく伝わらなくて失礼な補足を出していたら申し訳ありません。
No4のコードで１００までの数字についてはできているのですが、やはり１００以上の数字についてはなにも起こりません。（１から４６までは欠番が挿入されました。）私のエクセルが変なのでしょうか？

＞x46以降の連番についてはなにもしないということで
　たとえば　346以降　347,350,351と飛び番があっても無視してそのままです。

これはおっしゃるとおりでOKです。

何か改善策はありますか。

回答No.6

kmetu

> そのとおりです。可能ですか。よろしくお願い申し上げます

こういうことでしょうか…

Sub 欠番挿入()

Dim i As Integer, myAnyValue As Integer

myAnyValue = 46

For i = 0 To 999
If ActiveSheet.Range("a1").Offset(i, 0).Value = "" Then
Exit Sub
End If
ActiveSheet.Range("a1").Offset(i, 0).Activate
If i <> 0 Then
If ActiveCell.Value - ActiveCell.Offset(-1, 0) <> 1 _
And ActiveCell.Offset(-1, 0).Value < myAnyValue _
And ActiveCell.Offset(1, 0).Value <> myAnyValue Then
If ActiveCell.Value > 99 Then
For j = 1 To ActiveCell.Value - ActiveCell.Offset(-1, 0) - 1
Rows(ActiveCell.Row).Insert
ActiveCell.Value = myAnyValue
Next
Else
Rows(ActiveCell.Row).Insert
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
End If
End If
End If
If i = myAnyValue Then
myAnyValue = myAnyValue + 100
i = Int(myAnyValue / 100) * 100 - 1
End If
Next

End Sub

補足

今回も回答をありがとうございます。懸命に答えてくださるので恐縮しています。
試してみましたが、すみませんうまく伝わらなかったようでした。試してみたら、４６という行がやたら多く挿入されました。

行いたいのは１，２，３，４…４３，４４，４５，４６までの整数行を挿入、１０１，１０２，１０３，１０４…１４３，１４４，１４５，１４６までの整数行を挿入、２０１，２０２，２０３，２０４…２４３，２４４，２４５，２４６までの整数行を挿入、３０１，３０２，３０３，３０４…３４３，３４４，３４５，３４６までの整数行を挿入という具合に行をどんどん挿入し、A列の最後の数字が入っている行まで挿入し続けるというものです。いかがしょうか。

回答No.5

kmetu

> 私のやりたかったのは、１から４６まで挿入したら、次は１００から１４６まで、
> 次は２００から２４６まで、次は３００から３４６までという具合に、
> Ａ列の最後の行まで入っている数字（およそ１０００まで）について、
> 次の「くらい」に飛んで下２桁が４６になるように欠番を挿入するものです。

100以上でもX46までは連番として挿入されるのですが…。
100から146までの欠番はすべて146に
200から246までの欠番はすべて246に
ということでしょうか？

補足

回答ありがとうございます。

＞100から146までの欠番はすべて146に
200から246までの欠番はすべて246に
ということでしょうか？

そのとおりです。可能ですか。よろしくお願い申し上げます。

回答No.3

kmetu

> ご回答ありがとうございます。とてもシンプルで美しいのですが、完全なコードでご教授いただけませんか。

以下のような状態でいかがでしょう。

Sub 欠番挿入()

Dim i As Integer, myAnyValue As Integer

myAnyValue = 46

For i = 1 To 1000

If ActiveSheet.Range("a2").Offset(i, 0).Value <> "" _
Or ActiveSheet.Range("a2").Offset(i, 0).Value <= myAnyValue Then

If ActiveSheet.Range("a2").Offset(i + 1, 0).Value = "" Then
Exit Sub
End If

ActiveSheet.Range("a2").Offset(i, 0).Activate

If ActiveCell.Value - ActiveCell.Offset(-1, 0) <> 1 Then
Rows(ActiveCell.Row).Insert
ActiveSheet.Range("a2").Offset(i, 0).Value _
= ActiveCell.Offset(-1, 0).Value + 1
End If

End If

If i = myAnyValue Then
myAnyValue = myAnyValue + 100
i = Int(myAnyValue / 100) * 100 - 1
End If

Next

End Sub

補足

ご回答ありがとうございます。Ａ列に適当な数字を下へ割り振って試してみたが、１００までは４９までの欠番が挿入され、１００以上は何も変化がありませんでした。その後私もこのコードを少しいじったのですが、どうやらうまくいきません。もし可能であれば手を加えていただき、修正してもらえると大変助かります。よろしくお願い申し上げます。

回答No.2

imogasi

処理をする発想（ロジックという）は色々在る。
経験では、行挿入法は、処理に時間がかかるように思うし、ロジックも難しく成りがち。
ーー
それで別シートに実現法を考えた。
例データ　Ｓｈｅｅｔ１　
Ａ２：Ｄ６　　Ｄ列までの例　Ａ列に数字の番号有りとする。
1 a aa aaa
3 b bb bbb
6 c cc ccc
9 d dd eee
4 x xx xxx
番号順で無くても良い。
ーーーー
結果　Ｓｈｅｅｔ２
Ａ２：Ｄ３１
1 a aa aaa
2
3 b bb bbb
4 x xx xxx
5
6 c cc ccc
7
8
9 d dd eee
10
・・・
１１行目以下掲載略
＝＝＝
コード　標準モジュールに

Sub test01()
Dim sh1, sh2 As Worksheet
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
'---A2セルから連番を振る。例として番号を３０までにしている。下記のA31は、必要番号の数に寄り適宜考えて。
sh2.Range("A2") = 1
sh2.Range("A2:A31").DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=1, Trend:=False
'---Ｓｈｅｅｔ１からＳｈｅｅｔ２ヘコピー
d = sh1.Range("A65536").End(xlUp).Row
MsgBox d
For i = 2 To d
n = sh1.Cells(i, "A") '番号
MsgBox n
sh1.Range("A" & i & ":x" & i).Copy sh2.Cells(n + 1, "A") 'Ｓｈｅｅｔ２のしかるべき行に貼り付け
Next i
End Sub
データ列は最多でＸ列までと仮定

補足

お礼が遅くなりすみません。ご回答ありがとうございます。発想がとても豊かで、思いつきませんでした。ボックスが出てくるのでひたすらEnterキーを押し続けました。そしたら、Ｂ列からＤ列までの値がShhet2に反映されました。ありがとうございます。ただし、１から４６までいったら１００へ飛んで１４６まで欠番挿入し、そしてさらに２００へ飛んで２４６まで欠番挿入し…という具合にはうまくいきませんでした。困りました。

回答No.1

kmetu

> 例えば、１から４６まで、１００から１４６まで、２００から２４６まで、３００から３４６までという具合

たとえば以下のようなことで可能です。

myAnyValue = 46

For i = 1 To 1000

'やりたいことのコード

If i = myAnyValue Then
myAnyValue = myAnyValue + 100
i = Int(myAnyValue / 100) * 100 - 1
End If

Next

補足

ご回答ありがとうございます。とてもシンプルで美しいのですが、完全なコードでご教授いただけませんか。自分が提示したものに、回答いただいたコードを加工編集したいのですがうまくいきません。よろしくお願い申し上げます。