マクロ データ加工 番号に合わせて行を挿入し移動

質問

添付の左の状態から右の状態に加工するマクロが知りたいです。

A列：A7から１~18まで番号、空白1行、１~18まで番号、空白1行…繰り返し
左のB列：B１のみ見出し、B2からタイトル、１~いずれかのの番号（９だったり16だったりいろいろ）、タイトル、１~いずれかのの番号、タイトル…繰り返し
左のC列とD列：B列の番号に該当する氏名（漢字）と生年月日（数字8桁）

右の状態にするには最初の1~4行を下げる、赤の番号と黒の番号を合致するように移動し、黒の番号がないときはその行を18まで空白行にする、タイトル、番号を合わせて移動…という繰り返しになります。（黄色の部分を空白行にして調整するかんじです。黄色の塗りは必要ありません。）この手順でなくても結果が同じになれば良いです。

黒の番号は通常は連番ですが、まれに途中の番号がぬけている（例１、２、３、６、７）場合がありますが、その際には抜けている行（例４、５）を空白行にしてもらえると助かります。

回答No.5

tsubu-yuki · ベストアンサー

何か色々勘違いなさっているようで。
ま、その辺りは置いといて。
ついでにマルチポストの
　　https://okwave.jp/answer/new?qid=9342454
にも対応できていると思いますよ。

図のＡ列は邪魔なので列削除しといてください。
つまり「見出し」及び「番号」がＡ列に来るようにしてください。
Sub Sample()
　　j = 18
　　For i = Cells(Rows.Count, 1).End(xlUp).Row + 1 To 2 Step -1
　　　　If IsNumeric(Cells(i - 1, 1)) = False Then
　　　　　　j = 18
　　　　Else
　　　　　　If Cells(i - 1, 1) < j Then
　　　　　　　　Do Until Cells(i - 1, 1) = j
　　　　　　　　　　Rows(i).Insert
　　　　　　　　　　Cells(i, 1) = j
　　　　　　　　　　j = j - 1
　　　　　　　　Loop
　　　　　　End If
　　　　　　j = j - 1
　　　　End If
　　Next
End Sub
初心者向けに難しい命令を使わずに書いてみました。
無駄は多いですが、いかがですか？

「タイトル」の直下行が「１」以外だとうまく動きませんが、
例示にそのパターンが無いので無視します。
ま、少し考えれば回避できますので、そこは自力で学習なさってください。

回答No.6

SI299792

作ってみました。
次の場合動作保証はしません。
Ａ列が１から始まる連番でない。
Ａ列に数字以外がある。
Ｂ列が１行目から始まっていない。
Ｂ列に空白がある。
Ｂ列の番号が順番通りでない。（抜けはあってもいいが、昇順に並んでいて、重複がないこと）
Ｂ１以外に見出しがある。タイトルが２行以上ある。
'
Option Explicit
'
Sub Macro1()
　　Dim ey As Long
　　Dim oy As Long
　　Dim iy As Long
　　Dim A As Integer
　　Dim B As String
'
　　Application.ScreenUpdating = False
　　ey = Cells(Rows.Count, "A").End(xlUp).Row
　　Range("G1:G" & ey) = Range("A1:A" & ey).Value
　　Columns("H:J").ClearContents
　　oy = [A1].End(xlDown).Row
　　Cells(oy - 2, "H") = [B1]
　　iy = 3
'
　　For oy = oy To ey
　　　　A = Cells(oy, "A")
'
　　　　If A = 1 Then
　　　　　　Cells(oy - 1, "H") = Cells(iy - 1, "B")
　　　　End If
'
　　　　B = Cells(iy, "B")
　　　　If A = Val(B) Then
　　　　　　Cells(oy, "H").Resize(1, 3) = Cells(iy, "C").Resize(1, 3).Value
　　　　　　iy = iy + 1
　　　　End If
　　Next oy
End Sub

お礼

一応できました。実際に使うにはちょっと修正しないといけないっぽいですが、ありがとうございます。

回答No.4

imogasi

私が勝手にデータを決めてやってみた例を参考に上げる。
ただしＡ列の赤字の番号は、なぜ、Ａ７から始まり、Ｂ３からの番号データとづれているのかわからず、無視した。
またタイトルは各ブロックでそのタイトル文字列が違うのだろうが例データを書くなら、別の文字列にしたら（手抜きしすぎ）。
私は各タイトルのカタマリ（の切れ目）に注目しての、処理ロジックを考えた。
基本的に左（Ｂ列から）のものを右（Ｈ列から）に移すだけのタイプだ。
上下の行順序はこの課題では、変えて無いようだ。
ーー
（ここから下記データ部分を自分のシートにコピペして、データー区切り位置で各列の表にできないかやってみて）
例データ　Ｂ，Ｃ，Ｄ列で
見出し
タイトル1
1 a1 ＤｏＢ
2 a2 ＤｏＢ
3 a3 ＤｏＢ
4 a4 ＤｏＢ
5 a5 ＤｏＢ
6 a6 ＤｏＢ
7 a7 ＤｏＢ
8 a8 ＤｏＢ
9 a9 ＤｏＢ
タイトル2
1 ｂ１ ＤｏＢ
2 ｂ２ ＤｏＢ
3 ｂ３ ＤｏＢ
4 ｂ４ ＤｏＢ
5 ｂ５ ＤｏＢ
6 ｂ６ ＤｏＢ
7 ｂ７ ＤｏＢ
8 ｂ８ ＤｏＢ
9 ｂ９ ＤｏＢ
10 ｂ１０ ＤｏＢ
11 ｂ１１ ＤｏＢ
12 ｂ１２ ＤｏＢ
13 ｂ１３ ＤｏＢ
14 ｂ１４ ＤｏＢ
15 ｂ１５ ＤｏＢ
16 ｂ１６ ＤｏＢ
タイトル3
1 ｃ１ ＤｏＢ
2 ｃ２ ＤｏＢ
3 ｃ３ ＤｏＢ
4 ｃ４ ＤｏＢ
5 ｃ５ ＤｏＢ
6 ｃ６ ＤｏＢ
タイトル4
1 d1 ＤｏＢ
2 d2 ＤｏＢ
タイトル5
1 e1 ＤｏＢ
2 e2 ＤｏＢ
タイトル6
1 f1 ＤｏＢ
2 f2 ＤｏＢ
3 f3 ＤｏＢ
ーーー
コード　標準モジュールに
Sub test04()
Set sh1 = Worksheets("Sheet1")
lr = sh1.Range("c100000").End(xlUp).Row
'--見出し
sh1.Range("h5") = sh1.Range("B1") '見出し 初期の空白4 行の空白のあと第５行目に
'---タイトルリスト
t = Array("タイトル1", "タイトル2", "タイトル3", "タイトル4", "タイトル5", "タイトル6", "")
'--タイトル行
k = 6 '初期の空白4 行を含む。次は６行目
f = 2 'Ｂ列で最初のタイトル行の位置
'--
m = 1 'タイトル２から
'---
For i = 3 To lr
If sh1.Cells(i, "B") = t(m) Then
MsgBox i
sh1.Range("B" & f & ":D" & (i - 1)).Copy sh1.Range("H" & k)
' 次のタイトル部分の用意
k = k + (i - f + 1)
k = k + 8
f = i
m = m + 1
End If
Next i
'---
p2:
sh1.Range("B" & f & ":D" & lr).Copy sh1.Range("H" & k)
End Sub
ーー
結果　上記のデータで実際実行してください。一部を挙げます。
（4行空白）
見出し
タイトル1
1 a1 ＤｏＢ
2 a2 ＤｏＢ
3 a3 ＤｏＢ
4 a4 ＤｏＢ
5 a5 ＤｏＢ
6 a6 ＤｏＢ
7 a7 ＤｏＢ
8 a8 ＤｏＢ
9 a9 ＤｏＢ
（略）
タイトル4
1 d1 ＤｏＢ
2 d2 ＤｏＢ

タイトル5
1 e1 ＤｏＢ
2 e2 ＤｏＢ
＝＝
小生自身、不満足な点は、タイトルを目視で広い、配列に持って行っていること。
特徴がわかればプログラムで、配列に収納できると思う。
何かＢ列の「タイトル」行で、それらの行を拾えるような、特徴的な文字列の一部にはないのか？ 表設計でタイトル列と番号列は別列に分ける設計にすべきだとおもう。
ーー
コード作成に手間のかかる課題だが、回答者にとって、他の質問などの勉強には為にならない課題だと感じた。
丸投げ的に回答を求めるのでなく、処理ロジックを考えて自分で試行してみること。

タイトル2
1 ｂ１ ＤｏＢ
2 ｂ２ ＤｏＢ
3 ｂ３ ＤｏＢ
4 ｂ４ ＤｏＢ
（略）

補足

最初のやつ、どの区切りで分けるのか、そこでまず分かりません。タイトルというのは１R、２R・・・となっています。
ちなみに他の方法を考えて質問したので、そちらができればそちらの回答をお願いできますでしょうか？
「指定した行数を挿入する　マクロ」
https://okwave.jp/qa/q9342454.html

回答No.3

tsubu-yuki

Ｃ列をコピーしてＡ列に張り付けるだけですが、
そんなに難しいですか？

補足

ちゃんと添付を見てください。説明もちゃんと読んでください。右の方は黄色い部分を空ける必要があるということです。コピペするだけなら質問しませんよ。

回答No.2

tsubu-yuki

逆に、Ａ列を削除しながら上にあげていくほうが
初心者には簡単な気がします。

ぜひ、補足ください。

補足

A列を上げる？　黄色い部分を空けるにはどうしたらいいんですか？　今勉強中ですが、初歩レベルでこの程度だとむずかしくでわかりません。至急必要なので、サンプルを作っていただきたいです。