| 
    
     |  | ▼Aoichi さん:こんにちは〜 
 Dictionaryを使うのは Try1といっしょですが、
 今度は Dictionaryを2つ用意して、1回のLoopのなかで
 重複して出てきたアイテムだけを dic2 に格納するように
 してみました。
 
 Sub Try2()
 Dim i As Long
 Dim v As Variant
 Dim dic As Object
 Dim dic2 As Object '重複アイテムを格納する
 
 Set dic = CreateObject("Scripting.Dictionary")
 Set dic2 = CreateObject("Scripting.Dictionary")
 With Worksheets("重複Data")
 v = .Range("C4", .Cells(.Rows.Count, 3).End(xlUp)).Value2
 End With
 For i = 1 To UBound(v)     '商品コードをDictionaryに登録
 If Not dic.Exists(v(i, 1)) Then
 dic(v(i, 1)) = Empty
 ElseIf Not dic2.Exists(v(i, 1)) Then
 dic2(v(i, 1)) = Empty
 End If
 Next
 With Worksheets("重複一覧")
 .[C3].Value = "重複一覧"
 .[C4].Resize(dic2.Count).Value2 = _
 Application.Transpose(dic2.Keys)
 End With
 End Sub
 
 
 |  |