Excelで縦の並び順が違っていたて統一する方法

質問

以下のように本名を先頭に4項目並んでいるデータが数千件あるのですが
本名
価格
発行年
著者
本名
価格
発行年
著者
・
・
このデータの中で先頭が本名で、並び順は変わらないのですが
価格の行が抜けていたり、著者の行が抜けているデータも
あります。
これらのデータを4項目に統一したいです。
今考えている方法はマクロでA列を選択して「本名」の
次の行が「価格」になっていなかったら、行を追加して
「価格」行を作る感じです。
多分マクロが手っ取り早いと思いますが、ご教授
お願いします。

回答No.3

DOUGLAS_ · ベストアンサー

merlionXX さんの [回答番号：No.2] の「Sub test01()」と同じ条件下です。

　セル A1 から１セルずつ下に下がっていって、項目が合致しない場合に [行挿入] - [項目名入力] します。

Sub Macro1()
　Dim myKomoku As Variant, i As Byte
　myKomoku = Array("本名", "価格", "発行年", "著者")
　Range("A1").Select
　Do
　　For i = 0 To 3
　　　If Selection.Value <> myKomoku(i) Then
　　　　Selection.EntireRow.Insert
　　　　Selection.Value = myKomoku(i)
　　　End If
　　　Selection.Offset(1).Select
　　Next
　Loop Until Selection.Value = ""
End Sub

お礼

早速の連絡ありがとうございました。
試したところ、merlionXXさんと結果は同じですが
コードは簡潔ですね。
助かりました。
マクロって勉強したら便利そうですね。

回答No.2

merlionXX

データがA1から始まっているものとします。
データは、本名、価格、発行年、著者の四種類のみとします。
データ列（A列）の途中には空白セルがないものとします。
データの抜けはあっても並びはかならずご提示の通りとします。
以上の前提でつくってみました。

Sub test01()
With ActiveSheet
.Cells(1, 1).Activate
Do Until ActiveCell.Offset(1).Value = ""
Select Case ActiveCell.Value
Case "本名"
If ActiveCell.Offset(1).Value <> "価格" Then
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.Offset(1).Value = "価格"
End If
Case "価格"
If ActiveCell.Offset(1).Value <> "発行年" Then
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.Offset(1).Value = "発行年"
End If
Case "発行年"
If ActiveCell.Offset(1).Value <> "著者" Then
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.Offset(1).Value = "著者"
End If
End Select
ActiveCell.Offset(1).Activate
Loop
End With
End Sub

お礼

早速の連絡ありがとうございました。
テストしたら正に希望通りの結果が出ました。
早速実務で生かしてみます。

回答No.1

ASIMOV

Ａ列に「本名」とか「価格」と入っていて、Ｂ列に「○○○○」（本の名前）とか「１５００円」と入っているのか．．．
それとも、いきなりＡ列にデータが入っているのか？
どうなんでしょう

補足

ご連絡ありがとうございます。
Ａ列に「本名」とか「価格」と項目だけ入っていて、Ｂ列には
そのデータが入力されています。