| 
    
     |  | ▼Yuki さん: 
 返信ありがとうございます
 Yukiさんのアドバイスのようにやってみたところ、いまいち
 うまく行かず・・・(私の記述がおかしいのかもしれないけど。。。)
 
 下記のように作成してみました
 
 Dim MyD As Object
 Dim MyKey, MyItem
 
 Set MyD = CreateObject("scripting.dictionary")
 
 For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
 If Not MyD.exists(Range("A" & i).Value) Then
 MyD.Add Range("A" & i).Value, Range("B" & i).Value
 End If
 Next i
 
 MyKey = MyD.keys
 MyItem = MyD.items
 
 Sheets(2).Activate
 For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
 For u = 0 To UBound(MyKey)
 If Range("A" & i).Value Like MyKey(u) Then
 Range("B" & i).Value = MyItem(u)
 End If
 Next u
 Next i
 
 しかし、このコードだと、とても時間がかかってしまう難点があります
 いろいろと試行錯誤してもう少し考えてみます
 
 
 >  If MyD.exists(Range("A" & i).Value) Then
 >    '↑ココで、指定文字を含むものがあるか?どうか?を判断させたいです
 >    ' もう一度聞く
 >    If MyD.Item(Range("A" & i).Value) Like "指定文字" Then
 >      Range("B" & i).Value = MyD.Item(Range("A" & i).Value)
 >    End If
 >  End If
 >こんな風でどうでしょう。
 >検証していないので間違っていたら失礼
 
 |  |