必要行をコピーして増やし、データも付随させたい

質問

文章でうまく説明できないので、添付データを見てください。
上の図を、下の図のように変換する関数または、マクロ等教えてください。

・エクセル2010を使用しています。
・データは、5000行ほどあり、空欄が多く含まれています。
・作業列（D列）は、必要な増やしたい行数です。最大は7で、データはY列まであります。
　（模索している中でCOUNT関数を使い出ただけのもので、不必要なら削除できます。）
・G列、J列、M列、P列はMID関数で出た列で、不必要なら削除できます。
・セルの色はわかりやすいように付けてあるだけで、実際のデータには色はありません。

マクロはこれから勉強の段階です。
ご教授よろしくお願いいたします（深）

回答No.4

tom04 · ベストアンサー

No.1・3です。

No.3の補足の件について・・・

＞また、マクロ実行後はデータは変更してはいけないものなのか

前回のコードでは行挿入　→　データコピー　の後、元のD列データがそのまま残っていると思います。
D列数値より1行分少ない行数を挿入するようにしていますので、
マクロ実行後、もう一度マクロを実行すると
その残っているところに新たに行が挿入されてしまいます。

そこで一案ですが、一度マクロを実行するとD列データを消すようにしてみてはどうでしょうか？
そうすれば何度マクロを実行してもデータ変更はありませんし、
D列データに手を加えるだけでD列データがあるところだけが行挿入され、前回と同じ動きになると思います。

前回コードの
＞Loop
の後に
Cells(i, "D").ClearContents
の1行を追加してみてください。

これでD列（作業列）のデータが表示されなくなるはずですので、
新しいデータを行挿入し、D列に数値データがあるところだけが前回のような動きになると思います。

※　コードを考える時間についてですが・・・
まずこちらでExcelを立ち上げ、画像のような仮のデータを入力しています。
その間に頭の中で規則性などを見出しながらデータを入れています。

後はどうすればご希望に近い動きになるか？と思いながらコードを考えています。
今回の場合、時間的には仮のデータを入力し始めて20～30分程度でしたかねぇ～！

コード入力中にはエラーが出ないか？もっと簡単なコードはないか？等々
そこそこ気は使っているつもりです。m（_ _）m

お礼

補足への回答ありがとうございます！

マクロを実行して、何の反応もなく、続けてマクロを実行してからデータを確認したら、
「あれ、二重に行が挿入されてる！」となったので、初心者にとってＧ列が消えるのはありがたいです。
おっしゃるとおり、その後にデータを追加してもほかに影響がないのは安心です。
さっそく、コードに取り入れました！

（ちなみに、Ａ列の追加は必要なくなりました。）

※興味本位の質問に丁寧に答えていただき、重ねてありがとうございます！
＞仮のデータを入力し始めて20～30分程度・・・読んだ時、「え゛っ！」と声が出てしまいました。
私が仮のデータを作り終えるより早い（笑）
エクセルを使いはじめて１０か月になり、できることが増えていき、
勉強のし甲斐があると感じていましたが・・・そうですか～、20分。かっこいいなぁ～。
とてもいいことを聞かせていただきました！
もっともっと勉強したいと思います！
また、見ず知らずの質問者のため、親身に考えてくださっていること、
とても暖かく感じることができました。
ありがとうございました。

回答No.3

tom04

No.1です！
たびたびごめんなさい。

＞・G列、J列、M列、P列はMID関数で出た列で・・・
の部分を見逃していました。

前回のコードですと単にコピー＆ペーストですので、
数式が入っている場合は数式そのものがコピー＆ペーストされてしまい
エラー表示になるかもしれません。

＞Cells(i, cnt * 3 + 5).Resize(, 3).Copy Cells(i + cnt, "E")
の行を

With Cells(i, cnt * 3 + 5).Resize(, 3)
.Value = .Value
.Copy Cells(i + cnt, "E")
End With

の4行に変更してください。
（元データを「値」に置き換えて、それをコピー＆ペーストします）

※　仮にA～C列も数式によって表示されている場合は
＞Cells(i, "A").Resize(, 3).Copy Cells(i + cnt, "A")
の行を

With Cells(i, "A").Resize(, 3)
.Value = .Value
.Copy Cells(i + cnt, "A")
End With

に変更してください。

検証していませんので、ちゃんと表示されなかったらごめんなさいね。m（_ _）m

補足

ありがとうございました！
思い通りの表ができあがり、すごくすごく感動しました！

このマクロを実行した後で、A列に新しく行を挿入してデータを入れても、
マクロとその結果に影響はありませんか？
実際に、列を挿入し、関数ありのデータを入力しましたが、一見問題ないようです。
しかし、マクロの知識がないため、知らぬところで影響が出ているのに気づいていないだけでしょうか。
また、マクロ実行後はデータは変更してはいけないものなのか、
教えていただけますでしょうか。

もう一つ、興味だけの質問になりますが、
私の質問を読んでから、どのくらいでこのマクロを完成させたのですか？
調べずともすぐに浮かぶのですか？
すみません、くだらない質問です。

回答No.2

KURUMITO

関数で対応することができます。
お示しの上の表がシート1に有るとします。1行目が項目名で2行目から下方にデータが入力されているとします。
そこで作業列のD列ですがD2セルには次の式を入力して下方にドラッグコピーしてください。

=IF(A2="","",IF(ROW(A1)=1,COUNT(E2:XX2),D1+COUNT(E2:XX2)))

お示しの下の表はシート2に表示させるとしてA1セルからG1セルまでにお示しの項目名が有るとします。
A2セルには次の式を入力してG2セルまで横にドラッグコピーしたのちに下方にもドラッグコピーします。

=IF(ROW(A1)>COUNT(Sheet1!$E:$XX),"",IF(COLUMN(A1)<=3,INDEX(Sheet1!$A:$C,IF(ROW(A1)<=MIN(Sheet1!$D:$D),ROUNDUP(ROW(A1)/MIN(Sheet1!$D:$D),0)+1,MATCH(ROW(A1)-0.1,Sheet1!$D:$D,1)+1),COLUMN(A1)),IF(COLUMN(A1)=4,"",IF(COLUMN(A1)<8,INDEX(Sheet1!$E:$XX,IF(ROW(A1)<=MIN(Sheet1!$D:$D),ROUNDUP(ROW(A1)/MIN(Sheet1!$D:$D),0)+1,MATCH(ROW(A1)-0.1,Sheet1!$D:$D,1)+1),COUNTIF($B$2:$B2,$B2)*3-2+COLUMN(A1)-5),""))))

お礼

回答ありがとうございました。
私の説明不足で、A列からY列まで空白の行が多数あるので、
いくつかエラーがでてしまい、私のレベルでは長い関数のどこを直せばいいのか
わかりませんでした。
せっかく、ご教授いただいたのに申し訳ないです。
今回は、マクロの方で実行したいと思います。
でも、今回、非常に関数の勉強になりました。
今後、この関数で実行できるよう自分への課題にしたいと思います。
ありがとうございました。

補足

早速の回答ありがとうございます。
わたしがほぼ2日間調べても、まったくわからなかったはずですね。
こんなに長い関数初めて使います！
関数を解読するのに、また1日かかりそうです（笑）

これから、データに関数を入力して関数版でも実行してみたいと思います。

回答No.1

tom04

こんばんは！
一例です。

シートモジュールです。

Sub Sample1()
Dim i As Long, cnt As Long
Application.ScreenUpdating = False
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i, "D") > 1 Then
Rows(i + 1 & ":" & i + Cells(i, "D") - 1).Insert
cnt = 0
Do Until cnt = Cells(i, "D") - 1
cnt = cnt + 1
Cells(i, "A").Resize(, 3).Copy Cells(i + cnt, "A")
Cells(i, cnt * 3 + 5).Resize(, 3).Copy Cells(i + cnt, "E")
Loop
End If
Next i
Application.ScreenUpdating = True
End Sub

※　画像ではH列以降が表示されていませんので
もしH列以降が不要であれば
＞Application.ScreenUpdating = True
の前に
＞Range("H:Y").ClearContents
の1行を追加してみてください。m（_ _）m

お礼

回答ありがとうございました。
NO.3のマクロを組み込んで実行したところ、問題なくできました。
初めてマクロを実行しましたが、あっさりしすぎで、実際に結果がでていることに
気づけず、何回か繰り返してしまいました（笑）

補足

早速の回答ありがとうございます。
初めて画像を添付したので、なぜ、Ｈ列までの表示になったか原因がわからないので
直せなくてすみません。

列(EFG)と同じ入力欄が、(HIJ)(KLM)(NOP)(QRS)(TUV)(WXY)と続いており、
最大７行の挿入が必要ということです。画像が切れて、分かりにくい状態ですみません。

これから、ご教授いただいたマクロでやってみたいと思います。