[[20160519114341]]　『重複チェック（VBAバージョン）　[[2016051316502』（くろ）　ページの最後に飛ぶ

『重複チェック（VBAバージョン）　[[20160513165024]] 続き』（くろ）

以前、20160513165024で質問させて頂いたVBAパターンも検討しています。

前回と同じですが、以下に要件を再記述します。

関数パターンはねむねむさんにご教示して頂いた以下で可能です。
=IF(SUMPRODUCT(LEN(A$1:A$100000)-LEN(SUBSTITUTE(A$1:A$100000,A1,"")))>LEN(A1),"重複","")
大文字／小文字区別も必須。

(データ)
A列　　　　　　　　B列
BLACK 　　　　　　重複
BLACK+Red
Black
black 　　　　　　重複
BLUE 　　　　　　重複
BLUE/SILVER
Blue
RED
Red
SILVER 　　　　　　重複
SILVER[black]
Silver

VBAならスグにできると思っておりましたが、
意外に処理時間が掛ったりなど苦戦しております。

また、お力をお借りしたく、宜しくお願いいたします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 とりあえず、前トピで、ちょっとふれたコードです。（試作品ですので、あまり体裁は考えていません）

 Sub test()
    Dim t As Double
    t = Timer

    Dim w As Variant
    Dim v As Variant
    Dim s As String
    Dim i As Long
    Dim reg As Object

    With Range("A1", Range("A" & Rows.Count).End(xlUp))

        ReDim w(1 To .Rows.Count)
        ReDim v(1 To .Rows.Count, 1 To 1)

        For i = 1 To .Rows.Count
            w(i) = Cells(i, "A").Value
        Next

        s = Join(w, vbTab)

        Set reg = CreateObject("VBScript.RegExp")
        reg.Global = True

        For i = 1 To UBound(w)
            reg.Pattern = "([$()|\-\^\\[\]{}+*?.])"
            w(i) = reg.Replace(w(i), "\$1")
            reg.Pattern = w(i)
            If reg.Execute(s).Count > 1 Then v(i, 1) = "重複"
        Next

    End With

    Range("B1").Resize(UBound(v, 1)).Value = v

    MsgBox Timer - t

 End Sub

（β） 2016/05/19(木) 12:57

 くろさん
 単純に...

 Sub test()
    Dim a, i As Long, ii As Long
    With Cells(1).CurrentRegion.Resize(, 2)
        .Columns(2).ClearContents: a = .Value
        For i = 1 To UBound(a, 1)
            For ii = 1 To UBound(a, 1)
                If (i <> ii) * (InStr(a(ii, 1), a(i, 1))) Then a(i, 2) = "重複": Exit For
            Next
        Next
        .Value = a
    End With
End Sub
（seiya） 2016/05/19(木) 15:46

βさん、seiyaさんご回答ありがとうございました。

お二人のお考えを見て、すごく勉強になりました！
（私は長々と遠回りしていました。。。）

早々にご回答ありがとうございました。
また、宜しくお願いいたします。
（くろ） 2016/05/20(金) 17:06

コメント返信：

[ 一覧(最新更新順) ]

[[20160519114341]] 『重複チェック（VBAバージョン） [[2016051316502』（くろ） ページの最後に飛ぶ

[[20160519114341]]　『重複チェック（VBAバージョン）　[[2016051316502』（くろ）　ページの最後に飛ぶ