[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『重複チェック(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
お二人のお考えを見て、すごく勉強になりました!
(私は長々と遠回りしていました。。。)
早々にご回答ありがとうございました。
また、宜しくお願いいたします。
(くろ) 2016/05/20(金) 17:06
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.