力技でループを使って重複チェックをするとどうしても遅かった。
rangeオブジェクトをvariant型にいれると配列処理できることとDictionaryオブジェクトを覚えたので試しに作ってみたら爆速になったので覚書
重複のあるセルを見つけたものから色付けしていく。
戻り値として作成した配列を返してくれるのでいろいろ使える。
Function CheckDuplex(ByVal column_No As Long, ByVal n As Long, ByVal sh As Object)
'リストのユニーク配列を返す
'元のリストは操作しない
'返すユニーク配列はセルの値をキーに行番号を紐づけた連想配列になっている
'重複チェックを行い重複があればそのセルを色付けする
'戻り値としてユニーク配列と重複があったかどうかの判定用Boolean値を返す
'column_No:重複チェエクしたい行の番号、n:表の始まり補正数、sh:その表のあるタブのワークシートオブジェクト
Dim CELLVALUE As Variant
Dim isDuplex As Boolean
Dim dic As Variant, dicKey As Variant
Dim maxRow As Long, i As Long
Set dic = CreateObject("Scripting.Dictionary")
maxRow = sh.cells(Rows.count,column_No).end(xlUp)
isDuplex = False
CELLVALUE = Range(sh.Cells(1 + n, column_No), sh.Cells(maxRow, column_No))
For i = 1 To maxRow - n
dicKey = CELLVALUE(i, 1)
If dicKey <> "" Then
If dic.exists(dicKey) Then
sh.Cells(i + n, column_No).Interior.Color = RGB(255, 200, 200)
sh.Cells(dic.Item(dicKey), column_No).Interior.Color = RGB(255, 200, 200)
isDuplex = True
Else
dic.Add dicKey, i + n 'ライセンス番号をキーに記入してあるセルの行番号を紐づけ
End If
End If
Next i
CheckDuplex = Array(dic, isDuplex)
End Function