1
5

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

VBAで重複チェック

Last updated at Posted at 2018-11-19

力技でループを使って重複チェックをするとどうしても遅かった。
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
1
5
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
5

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?