歯抜けの番号を埋めて行の挿入

質問

部門　コード　商品名　業者　単位　分類　出数　原価　直営　単価差益

　3　　　　1　　　油　　 油屋　　　　缶　 油　　　　1　　500　　550　　50
　3　　　　2　　　水　　 水屋　　リットル　　水　 　1　　500　　550　　50
　3　　　　5　　　栗　　 栗屋　　　　kg　 野菜　　　1　　500　　550　　50
　3　　　　8　　　筍　　 筍屋　　　　kg　　野菜　　　1　　500　　550　　50

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
上の図を下の図の様に歯抜けになっている番号を入れたいのですが、地味な作業で入れていくにはかなりの量がありまして、何か良い方法がありましたら教えてください。

部門　番号　コード　商品名　業者　単位　分類　出数　原価　直営　単価差益

　3　　　1　　　1　　　油　　 油屋　　　　缶　 油　　　　1　　500　　550　　50
　3　　　2　　　2　　　水　　 水屋　　リットル　　水　 　1　　500　　550　　50
　 　　　3　　　
　 　　　4　
　3　　　5　　　5　　　栗　　 栗屋　　　　kg　 野菜　　1　　500　　550　　50
　 　　　6
　 　　　7　
　3　　　8　　　8　　　筍　　 筍屋　　　　kg　　野菜　　1　　500　　550　　50
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

回答No.3

websol · ベストアンサー

ＶＢＡを使います。
「フォーム」のツールバーからボタンを選択して好きなところにボタンを貼り付けます。
「マクロの登録」で「新規登録」以下のコードを貼り付けてください。
ワークシートのデータの範囲に、「範囲」という名前を付けます。
ボタンを押せばOK。

－－－－－－－－－－－－－－－－－－－－－－－－－

Sub ボタン1_Click()
Dim arange As Range
Set arange = Range("範囲")
Max% = arange.Rows.Count
i% = 1
While i% < Max%
If arange.Cells(i%, 2) <> arange.Cells(i% + 1, 2) - 1 Then
arange.Rows(i% + 1).Insert
arange.Cells(i% + 1, 2) = arange.Cells(i%, 2) + 1
Max% = Max% + 1
End If
i% = i% + 1
Wend
End Sub

お礼

有難うございます。

ボタンを押したらびっくりしました。

回答No.2

imogasi

先ほどの問題との関係は（逆の質問をしましたね。関数で
回答しようとしたら締めきられた）。
本質問ですが
Sheet３に空き行の無いデータが入っています。
最下行は第１０行と仮定しているので、実際は$B$10や$K$10を修正してください。
A3に
=IF(ISERROR(MATCH(ROW(A3)-2,Sheet3!$B$1:$B$10,0)),"",INDEX(Sheet3!$A$1:$K$10,MATCH(ROW(A3)-2,Sheet3!$B$1:$B$10,0),COLUMN(A3)))
といれ、K3まで複写する。
A3:K3を範囲指定して、K3で＋ハンドルを出して下へ引っ張る。
B列には他の列に連番をつくり、その連番をB列に値複写してください。

補足

有難うございます。

自分が担当している、データじゃないので分りやすいNo３を使用させていただきます。
大変勉強になりました。

回答No.1

hisappy

ＶＢＡでの対応を想定して回答します。
ただＶＢＡコードが判らないので、
ひとまずはアルゴリズムでの返答になることを
ご了承ねがいます。

前提条件
・コードが存在している場合、番号は同じ値となる。
・同じコードを持つデータは無い。
・コードは既に昇順となっている。
・番号の列は既に追加されている。

－－－－ここから

一番最後の行に行く。
［コード］の値を変数Ａに取得する。
do
{
　　if(変数Ａの値　＞　［コード］の値)
　　{
　　　　下に一行追加。
　　　　//この時、フォーカスが新しい行の
　　　　//［番号］列であって欲しい。。。
　　}

　　［番号］に変数Ａの値を入れる。
　　変数Ａの値を－１する。

　　フォーカスを一行上の［コード］に移す。
}
while(変数Ａの値がゼロになるまで)

・おしまい・

－－－－ここまで

こんな感じでしょうか。

お礼

有難うございました。
No3が自分にとって画期的だったのでそちらをせんたくすることにしました。
またよろしくお願いいたします。