マクロ【特定の列同士の比較方法】

質問

いつも大変御世話になります。

【D:\test】フォルダ内に、１つのエクセルファイル（Excel2003）があります。

・エクセルファイル名は【test.xls】。
・シート【起動シート】と【test】があります。

今回悩んでいるのはシート名【起動シート】内にあるマクロボタンに入れるマクロです。

理想の処理は以下のようになります。

シート【test】には以下のような文字が入力されています。

　　　　　A　　　　　B　　　　　C　　　　　D　　←列

1　　　　　　　　GoodList　　　　　　BadList　

2　　　　　　　　　L2008　　　　　　　L2009

3　　　　　　　　　L2009　　　　　　　L2015

4　　　　　　　　　L2010　　　　　　　　

5　　　　　　　　　L2015　　　　　　　　

6　　　　　　　　　L2030

↑行

このB列のL～が入力されているセルと、D列ののL～が入力されているセルの文字を比較し、
D列に入っているセル文字と一致したら、B列のそれと同じ文字が入力されているセル文字を消す。
つまり上記例だと以下のようになります。

　　　　　A　　　　　B　　　　　C　　　　　D　　←列

1　　　　　　　　GoodList　　　　　　BadList　

2　　　　　　　　　L2008　　　　　　　L2009

3 　　　　　　　　　(空白)　　　　　　 L2015

4　　　　　　　　　L2010　　　　　　　　

5 　　　　　　　　　(空白)

6　　　　　　　　　L2030　　　　　　　　　　　　

さらにそのB列で消えたセル（この場合B3とB5）を空白部分を上に詰めて以下のようにする。　　　　　　　　

　　　　　A　　　　　B　　　　　C　　　　　D　　←列

1　　　　　　　　GoodList　　　　　　 BadList　

2　　　　　　　　　L2008　　　　　　　　L2009

3　　　　　　　　　L2010　　　　　　　　L2015

4　　　　　　　　　L2030　　　　　　　　　　　　　　　　　

5　　　　　　　

6　　　　　　　　　　　　　　　　　　　　　

このようなマクロは可能でしょうか？関数ではなく、ぜひマクロで実施したいです。

ちなみに、C列には関係のない文字が入力されていますが、ここでは省略しております。

あくまで比較対象はB列とD列です。

ネット上に情報があるかと思い調べましたが、なかなかそういった処理方法にはであえませんでした。

何か簡単なサンプルコードをご教授願いますでしょうか？

余りにも初歩的な質問で申し訳ありませんが、宜しくお願い致します。

回答No.2

n-jun

Sub try()
Dim Dic As Object
Dim i As Long, j As Long
Dim v, w

Set Dic = CreateObject("Scripting.Dictionary")

v = Range("B2", Cells(Rows.Count, 2).End(xlUp)).Value
w = Range("D2", Cells(Rows.Count, 4).End(xlUp)).Value

For i = 1 To UBound(v, 1)
Dic(v(i, 1)) = Empty
Next

For j = 1 To UBound(w, 1)
If Dic.exists(w(j, 1)) Then Dic.Remove (w(j, 1))
Next

Range("B2:B" & Rows.Count).ClearContents
Range("B2").Resize(Dic.Count, 1).Value = _
Application.Transpose(Dic.keys)

Set Dic = Nothing
Erase v, w
End Sub

ご参考程度に。

お礼

ありがとうございました。

回答No.1

temtecomai2

各行頭のスペースはレイアウト保持のために全角スペースを使って表現していますので、VBA のコードモジュールに貼り付ける場合は行頭の全角スペースを半角スペースに置換してください。

処理の説明
1. D列のリストを配列に入れる
2. B列のリストを配列に入れる
3. 両リストの値を一つずつ比較する
4. 比較の結果重複していなかた B列リストの値を集める
5. B列の値をクリアしてから比較結果を転記する

Sub hoge()
　Dim targetSheet As Worksheet
　Set targetSheet = ThisWorkbook.Worksheets("test")

　' D列の値を配列に入れる
　' 配列に入れる範囲は、セル D2 ～ D列の最後に値が入っているセルまで
　Dim searchList() As Variant
　searchList = targetSheet.Range(targetSheet.Cells(2, 4), targetSheet.Cells(targetSheet.Cells(65536, 4).End(xlUp).Row, 4)).Value

　' B列の値を配列に入れる
　' 配列に入れる範囲は、セル B2 ～ B列の最後に値が入っているセルまで
　Dim sourceList() As Variant
　sourceList = targetSheet.Range(targetSheet.Cells(2, 2), targetSheet.Cells(targetSheet.Cells(65536, 2).End(xlUp).Row, 2)).Value

　Dim source As Variant ' 比較のために sourceList から値を順番に抜き出すための入れ物
　Dim what As Variant ' 比較のために searchList から値を順番に抜き出すための入れ物
　Dim destCollection As New Collection ' 比較の結果、重複しなかった値を入れておくためのコレクション
　Dim exist As Boolean ' 値が重複したかどうかのフラグ
　For Each source In sourceList
　　exist = False
　　For Each what In searchList
　　　' 値が重複していたらフラグを立てる
　　　If source = what Then
　　　　exist = True
　　　End If
　　Next

　　' 重複していなければ（フラグが立っていなければ）比較結果コレクションに値を追加する
　　If Not exist Then
　　　destCollection.Add source
　　End If
　Next

　' B列の値をクリアする
　targetSheet.Range(targetSheet.Cells(2, 2), targetSheet.Cells(targetSheet.Cells(65536, 2).End(xlUp).Row, 2)).Value = ""

　' 比較結果コレクションの値を B列に転記する
　Dim i As Long
　For i = 1 To destCollection.Count
　　targetSheet.Cells(i + 1, 2).Value = destCollection(i)
　Next
End Sub