EXCELのVBA,マクロでこれはどう記述するのでしょう?

質問

先日、類似の質問をしたものですが、下記のような表を作成し、A列の型データーを検索して、参照表からVLOOKUP関数で指定列の品番を表示させています。

　先日、質問内容が抽象的で分かりにくかったので再度、質問ですが、
　関数では出来ないことが前回の質問で分かり、VBAでないとダメだと言うことなんですが、
私のしたいことは、簡単に言いますと、B列の台数セルについて、セルの値を検索して台数が２００以上であつた場合、そのセルのある下段に空白行を２００なら１行、３００なら２行挿入するという風にしたいのです。

　これをVBAで実現するにはどのような記述が必要なのでしょうか?簡単に出来るのでしょうか?私はVBAは素人な者で、コード等は良く知りません。
　いつもやっているのは、記録マクロばかりで、定形作業で一度組んだマクロの変化する部分（日付、ファイル名）を編集、修正しかしておりません。だからいつもデバック画面と格闘しています。どなたか知っておられたらご指南、お願いします。
　 　A 　 　 B 　　　　 C 　　　 D
1 　型　　　台数　　品番
2　検索値　250
3　検索値 100
4　検索値 200
5 検索値 150
6 検索値 350

回答No.2

Wendy02 · ベストアンサー

こんばんは。
こんな風にしたらいかがかな？
設定のところだけ、書き換えればよいです。

Sub testInsert()
　 Dim i As Long
　 Dim j As Long
　 Dim rng As Range
　 With ActiveSheet
　 '----------------------------
　 '設定
　 Const FirstRow As Integer = 2 '最初の行・タイトル行あり
　 Set rng = .Range("B" & FirstRow, .Range("B65536").End(xlUp))
　 '----------------------------
　　　Application.ScreenUpdating = False
　　　For i = rng.Rows.Count To 1 Step -1
　　　　 With rng.Cells(i, 1)
　　　　　　'数値のチェック
　　　　　　If VarType(.Value) = vbDouble Then
　　　　　　　 j = Application.Min(Int(.Value / 100) - 1, 2)
　　　　　　　 If j > 0 Then
　　　　　　　　　.Offset(1).Resize(j).EntireRow.Insert
　　　　　　　 End If
　　　　　　End If
　　　　 End With
　　　Next i
　　　Application.ScreenUpdating = False
　 End With
　 Set rng = Nothing
End Sub

お礼

これまた非常に参考となる回答を頂き、助かります。早速、実行させていただきます。有難うございました。

回答No.3

imogasi

Sub test01()
d = Range("A65536").End(xlUp).Row
For i = d - 1 To 3 Step -1
Select Case Cells(i, "B")
Case Is >= 300
Rows(i + 1).EntireRow.Insert shift:=xlShiftDown
Rows(i + 1).EntireRow.Insert shift:=xlShiftDown
Case Is >= 200
Rows(i + 1).EntireRow.Insert shift:=xlShiftDown
End Select
Next i
End Sub
変数の定義、ScreenUpdatingなど略して最小限にしてます。

回答No.1

masa_019

>空白行を２００なら１行、３００なら２行挿入

ということは、210や250の時は考えなくてもいいと理解して、
以下のような感じでどうでしょう？

Sub TEST()
Dim lastRow As Long
Dim x As Integer
Dim i As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")
lastRow = .Range("B65536").End(xlUp).Row
For i = lastRow - 1 To 3 Step -1
x = .Cells(i, 2).Value
Select Case x
Case 200
.Rows(i + 1).Insert
Case 300
.Rows(i + 1 & ":" & i + 2).Insert
End Select
Next i
End With
Application.ScreenUpdating = True
End Sub

B列を下から調べて、200なら1行、300なら2行を
下に挿入します。

お礼

ご返答、有難うございます。
解説いただいた構文を参考にワークシートに融合させたいと思います。すみませんでした。