Excel９７で自動的に行挿入させるマクロのつくりかた。

質問

こんにちは。
マクロ超超初心者です。

WN98SE、Excel97です。
やりたいことは、たとえば、
B1に１００１
B2に１００１
B3に１００２
B4に１００３
　　　・
　　　・
　　　・
と入っていたとします。
ここで、１００１から１００２に変わる（又、１００２から１００３に変わる）とき、その間の行に3行空行を自動的に挿入させたいのですが、どういうマクロの記述をすればできるのでしょうか・・・。
それを新規ブックでもボタンひとつで実行させるにはどのような設定をしたらよいでしょうか。

どなたか教えてください。
よろしくおねがいします。

回答No.1

yomo3 · ベストアンサー

こんにちは。
マクロはこんな感じです。
急いで組んだので、手直しが必要かもしれません。

Sub Macro1()
Const NowCol=2 'B列
Const InsRows=3'3行挿入
Dim NowRow
Dim NowVal,PreVal
PreVal=Range("B1")
NowRow=1
Do
NowRow=NowRow+1
NowVal=Cells(NowRow,NowCol).Value
If NowVal=0 Then Exit Do
If PreVal<>NowVal Then
Rows(NowRow &":"&NowRow+InsRows-1).Select
Selection.Insert xlDown
PreVal=NowVal
NowRow=NowRow+InsRows-1
End If
Loop
End Sub

新規ブックでも使えるようにするには、
PERSONAL.XLS にマクロを保存します。

まず、ツール→マクロ→Visual Basic Editor でマクロ編集モードにします。
プロジェクトウインドウで、PERSONAL.XLSのVBAProjectを探してください。
PERSONAL.XLSがなかったら、イルカ君に聞いてみてください。確か、Excelのフォルダから読み込むはずです。
モジュールというフォルダアイコンのようなアイコンを右クリックして、挿入→標準モジュールでモジュールフォームを開いて、上記マクロをコピペしてください。
保存すれば、このマクロは新規ブックでも使えます。

ボタン一発で使えるようにするには、メニューやショートカットに登録すればＯＫです。
ちなみに、マクロ名は、Macro1 になっています。
上記コードの Sub の後の Macro1 を別の名前にすれば、マクロ名も変わります。
長くなったので、この辺で。

お礼

できました！！！！
ありがとうございます。
初心者にもわかりやすく感謝しています。
本当にありがとう。

回答No.3

GETSTREET

こんな感じでしょうか？

Sub SAMPLE()

ROW% = 1
Do While Cells(ROW, 2).Value <> ""
If Cells(ROW, 2).Value = Cells(ROW + 1, 2).Value Then
ROW = ROW + 1
Else
Rows(ROW + 1 & ":" & ROW + 3).Insert
ROW = ROW + 4
End If
Loop
End Sub

お礼

回答ありがとうございます。
ほかの方と同様、うまくうごいています。
本当に助かりました(~o~)

回答No.2

happypoint

48kgさん、こんにちは。

次のマクロでどうでしょうか。
B列に入っているデータをもとに、行挿入を繰り返します。
F11キーでVBE（コードエディタ）を立ち上げ、
標準モジュールに貼り付けてください。

ボタンひとつ、というのはシート上に貼り付けるボタンでいいのでしょうか。
でしたらメニューから、
　表示-ツールバー
で、「フォーム」を選択し、「フォーム」ツールバーを出してください。

そのなかに、ボタンがありますので、
これをクリックして、シートにボタンを描画します。
すると、「マクロの登録」画面がでますので、
これで「test」マクロをボタンに登録してください。

Option Explicit

Sub test()
Const lngCol As Long = 2 'Ｂ列をさがす
Dim lngRow As Long
Dim varVal1 As Variant
Dim varVal2 As Variant

'初期化
lngRow = 1

'ループ
Do While Cells(lngRow, lngCol).Value <> ""
　varVal1 = Cells(lngRow, lngCol).Value
　varVal2 = Cells(lngRow + 1, lngCol).Value
　If varVal1 <> varVal2 Then
　　Rows(lngRow + 1 & ":" & lngRow + 3).Insert '3行挿入
　　lngRow = lngRow + 3
　End If
　lngRow = lngRow + 1
Loop
End Sub

お礼

回答ありがとうございます！
＃１さんと同様、できました！！
感謝しています。