Excel VBAでデータを自動処理したい（２）

質問

Excelで大量のデータ処理をしなくてはならないのですが、以下の処理をExcel VBAで自動処理できないでしょうか？どなたかお知恵をお貸しください。
別シートに参照リストと未完成リストがあります。参照リストのA列のデータの並びと未完成リストのA列の並びを同じくして、未完成リストを完成させます。参照リストのA列の並びはこんな風です。1 2 3 3 5 6 7 8 8 10 ・・・（データは昇順ですが必ずしも連番ではなく、同じデータが並ぶこともあります。）　そして未完成リストの方は、1 2 3 4 5 7 8 10 ・・・といった風です。未完成リストのA列は1 2 3 3 4 5 7 8 8 10・・・という風にしたいのです。つまり参照リストにあっても、未完成リストにないデータは無視します。（上の例では、6です。）参照リストになくて、未完成リストにあるデータはそのまま残します。（上の例では、4です。）両方に共通のデータで参照リストのようにデータが重複しているときは、未完成リストの方に重複している分だけ行を挿入し、上のデータをコピーします。（上の例では、3と8です。）この処理を例えば、それぞれのA列を比較し、お互い共通していないデータ行をそれぞれのリスト上で不可視にし、そのあと、参照リストのA列のデータを参考に重複してるデータを見つけたら、未完成リストの方に重複している分だけ自動に行を挿入し、上のデータをコピーして、参照リストと未完成リストの共通のデータを同じならびにしたいのです。（このあと、参照リストのB,C,Dのデータを未完成リストにコピーするので、未完成リストにしかないA列のデータは、不可視にしておいて、B,C,Dのデータをコピーするときに行がずれないようにしたいのです。）
以上(1)、(2)の処理を自動にさせるためのVBAが分かる方がいらっしゃいましたら、是非ご教授お願いいたします。

回答No.1

nishi6

何度か読んでやりたいこと（かな？）を作ってみました。主旨を汲んでいなければお許しを。
参照リスト、未完成リスト、未完成リストの完成版が必要とお思いますので、それぞれSheet1,Sheet2,Sheet3に
対応して作りました。また、未完成リストの完成後フィルタを使ったりしてのコピー作業があるようなのでそれも組み込んでみました。コピーしたい列数-1をcopyColにセットします。私見ですがVBAで対応する場合は手作業を極力排除した方がいいと思います。質問ではA列の最後がどのようになっているか想像できませんでしたので、参照リスト個数＞＝＜未完成リスト個数の３パターンに対応しています。（つもりです）

Public Sub KanseiList()
Dim rg1, rg2, rg3 As Range '基準とするセル
Dim cot1 As Long '参照リストカウンタ
Dim cot2 As Long '未完成リストカウンタ
Dim cot3 As Long '完成リストカウンタ
'
Const copyCol = 3 'コピーする列数(0から)
Dim cl As Integer '列カウンタ
'
Set rg1 = Worksheets("Sheet1").Range("A1") '参照リスト
Set rg2 = Worksheets("Sheet2").Range("A1") '未完成リスト
Set rg3 = Worksheets("Sheet3").Range("A1") '未完成リスト完成版
Worksheets("Sheet3").UsedRange.Clear
'
With rg2
'未完成リストを順に調べる
While .Offset(cot2, 0) <> ""
Select Case True
Case .Offset(cot2, 0) = rg1.Offset(cot1, 0)
'参照リストと未完成リストが一致
While .Offset(cot2, 0) = rg1.Offset(cot1, 0)
For cl = 0 To copyCol
'参照リストのAからD列をコピーする
rg3.Offset(cot3, cl) = rg1.Offset(cot1, cl)
Next
cot1 = cot1 + 1 '参照リストを更に調べる
cot3 = cot3 + 1
Wend
cot2 = cot2 + 1
Case rg1.Offset(cot1, 0) <> "" And .Offset(cot2, 0) < rg1.Offset(cot1, 0)
'未完成リストしかない(参照リストはある)
While rg2.Offset(cot2, 0) <> "" And .Offset(cot2, 0) < rg1.Offset(cot1, 0)
rg3.Offset(cot3, 0) = .Offset(cot2, 0)
cot2 = cot2 + 1 '未完成リストを更に調べる
cot3 = cot3 + 1
Wend
Case rg1.Offset(cot1, 0) = ""
'未完成リストしかない(参照リストがない)
rg3.Offset(cot3, 0) = .Offset(cot2, 0)
cot2 = cot2 + 1
cot3 = cot3 + 1
Case .Offset(cot2, 0) > rg1.Offset(cot1, 0)
'参照リストしかない
cot1 = cot1 + 1
End Select
Wend
End With
End Sub

お礼

nishi6さん、早々のご回答ありがとうございます。早速やってみました。大成功でした。会社の皆で大喝采でした。本当にありがとうございます。今日は会社の仲間たちの顔が皆晴れやかで社内がパッと明るくなりました。ところでnishi6さん、ご相談のですが、こんなすばらしいプログラムを提供していただいて、恐縮なのですが、このプログラムに以下の機能を追加することは可能でしょうか？参照リスト（sheet1のデータ）にあって、未完成リストNo.1（sheet2のデータ）に無いデータは、未完成リスト完成版（sheet3）には反映されず無視されますよね。実はこの無視されたデータは後で、別の未完成リストNo.2と照し合せる必要があるのです。そこで、どのデータが無視されたものなのか後で分かるように,未完成リストNo.1上でこれらのデータに赤い色をつけるとか、またこのデータだけをsheet4に抽出する等（どちらか1つでいいのですが・・・）出来ますでしょうか？これが出来ると本当に鬼に金棒なのですが・・・。でもこのプログラムでも私たちにとっては本当に大助かりでございますので、もしnishi6さんが気が向いたら、ご返答いただければ・・・と図々しくもお願いした次第です。でもどうか気になさらないでくださいませ。ご迷惑でしたら、どうぞ無視されて結構です。まずは社員一同お礼心よりお礼申し上げます。では・・・。