エクセルマクロ 特定の条件抽出のあと、重複データを削除したいです！

エクセルでデータ管理をしています（データ件数１万ぐらい）
以下のようなデータがあります。

　　[調達番号][ID]　[カラー][データ１]
1　[H12－15][BCC][Blue]　[Sample]
2　[H12－15][BCC][Red]　[Shipping]
3　[H12－15][BCC][Pink]　[Sample]
4　[H15－20][FCF][Blue]　[Sample]
5　[H15－20][FCF][Red]　[Sample]
6　[H15－20][DMDCG][Red]　[Sample]・・・

と続いていきます。
まずはここからIDが「BCC」と「FCF」のデータを抜き出し、
その後、カラーとデータ１の情報はいらないので、重複している
データを削除して必要なデータのみにしたいです。
このデータで言えば、１、４のデータだけ抽出したいです。

BCCとFCFのデータの抜き出しは下記のように書いてうまく
いっているのですが、その後の重複データを削除する方法を
どなたか教えてください！

For i = rownumber To 2 Step -1
If Mid(.Cells(i, 5), 1, 3) = "BCC" Or _
Mid(.Cells(i, 5), 1, 3) = "FCF" Then
.Rows(i).Delete
End If
Next i

どうぞよろしくお願い致します！

No.1 ベストアンサー 回答者： tom04 回答日時： 2016/10/09 09:51

こんにちは！

＞データ件数１万ぐらい
というコトですので、
全ての行をループさせるとそこそこ時間を要すると思います。
オートフィルタの方法ではどうでしょうか？

元データはSheet1にあり、Sheet2に表示するとします。
尚、作業用としてSheet3を使用しますので、Sheet3は全く使っていない状態にしておいてください。

↓の画像のようにSheet1の1行目は項目行でデータは2行目以降にあるとします。
標準モジュールにしてください。

Sub Sample1()
Dim wS2 As Worksheet, wS3 As Worksheet
Set wS2 = Worksheets("Sheet2")
Set wS3 = Worksheets("Sheet3")
Application.ScreenUpdating = False
With Worksheets("Sheet1")
With .Range("A1").CurrentRegion
.AutoFilter field:=2, Criteria1:=Array("BCC", "FCF"), Operator:=xlFilterValues
.SpecialCells(xlCellTypeVisible).Copy wS3.Range("A1")
End With
wS3.Range("B:B").AdvancedFilter Action:=xlFilterInPlace, unique:=True
wS3.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy wS2.Range("A1")
.AutoFilterMode = False
End With
wS3.Cells.Clear
Application.ScreenUpdating = True
wS2.Activate
MsgBox "完了"
End Sub

※　最初に出現（一番上側の行）のデータが表示されます。

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

こんにちはー！
そしてありがとうございます！！！
既存のまくろにあわせるのにちょっと手間取りましたができました！！！
すごいすごい！気持ちいいですね笑
どうもありがとうございましたー！

お礼日時：2016/10/09 15:02