至急で申し訳ございません。Excelマクロ教えて下さい。

●　　A　　　　　B　　　　　C　　　　　D　　　　　E　　　　　F　　　　　G

1　　2/1　　　　10:00　　　10　　　　　0　　　　入荷　　　　出荷　　　リンゴa
2　　2/1　　　　11:00　　　10　　　　　2　　　　入荷　　　　出荷　　　イチゴb
3　　2/1　　　　12:00　　　10　　　　　1　　　　入荷　　　　出荷　　　リンゴa
4　　2/1　　　　12:00　　　10　　　　　1　　　　入荷　　　　出荷　　　リンゴa
5　　2/1　　　　13:00　　　10　　　　　0　　　　入荷　　　　出荷　　　リンゴa
6
7
8　　2/1　　　　14:00　　　10　　　　　2　　　　入荷　　　　出荷　　　リンゴc
9　　2/1　　　　15:00　　　10　　　　　0　　　　入荷　　　　出荷　　　イチゴa
10　 2/1　　　　16:00　　　10　　　　　10　　　　入荷　　　　出荷　　　リンゴb
11　 2/1　　　　17:00　　　10　　　　　0　　　　 入荷　　　　出荷　　　リンゴa
12　2/1　　　　18:00　　　10　　　　　　3　　　　入荷　　　　出荷　　　ミカンc
13　2/1　　　　19:00　　　10　　　　　　1　　　　入荷　　　　出荷　　　リンゴb
14　2/1　　　　19:30　　　10　　　　　　0　　　　入荷　　　　出荷　　　リンゴa
15　2/1　　　　20:00　　　10　　　　　　5　　　　入荷　　　　出荷　　　リンゴa

至急で申し訳ございません。
うまく記載できなかったのですが、上記のような表があり、（最終行は約2000行くらいです）
マクロで処理を行いたいのですが、構文がよくわかりません。
どなたか、エクセルのマクロにお詳しい方、ご教授をお願い致します。

G列の´リンゴ＊′の時にD列の′1′以外の数値分だけ空白行を直上に挿入させたいのです。
８行目のように直上に２行の空白行を挿入させたいです。
10行目の直上にD列の´10´に従い空白行を直上に挿入させたり、
15行目の直上にD列の´5´に従い空白行を直上に挿入させたいのです。

行数が多く、人間の目で確認していると間違ってしまう気がします。

何卒よろしくお願いいたします。教えてください。
教えてください。お願い致します。

No.2 ベストアンサー 回答者： tom04 回答日時： 2017/03/07 17:09

こんにちは！

D列の数だけ行挿入すればよいのですね？
D列はプラスの整数が入っているとします。
一例です。

Sub Sample1()
Dim i As Long
For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If Cells(i, "G") Like "リンゴ*" Then
If Cells(i, "D") > 1 Then
Rows(i & ":" & i + Cells(i, "D") - 1).Insert
End If
End If
Next i
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

早々のご回答ありがとうございます。
早速、試してみます。

お礼日時：2017/03/07 18:09

No.1 回答者： fujillin 回答日時： 2017/03/07 17:06

こんにちは

正しく解釈できているかわかりませんが、以下のような感じでしょうか？

Sub sample()
Dim rw As Long, length As Integer

Const key = "リンゴ"

length = Len(key)
For rw = Cells(Rows.Count, 7).End(xlUp).Row To 1 Step -1
　If Left(Cells(rw, 7).Text, length) = key Then
　　If Cells(rw, 4).Value > 1 Then
　　　Rows(rw).Resize(Cells(rw, 4).Value).Insert
　　End If
　End If
Next rw

End Sub

※ ´リンゴ＊’はＧ列の最初の3文字がリンゴ(=keyで指定可能)か否かで判断しています。
※ 行の挿入はご提示の例の6、7行目のように空白行があっても関係なく挿入します。
　(ご提示の例のまま実行すると、8行目の前に2行追加され、結果的に合計で4行の空白行ができます）

この回答へのお礼

早々のご回答ありがとうございます。
早速、試してみます。

お礼日時：2017/03/07 18:11