Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Pro : Excel 2013)
重複チェック
投稿日時: 21/06/03 21:38:44
投稿者: rragdoll

お世話になります。
Sheet1とSheet2で重複チェックをしたいのですが、下記のコードをSheet1の範囲をA2:Z40に変更して稼働するように出来ないでしょうか。
宜しくお願い致します。
 
Sub 重複チェック()
 
Dim Sht1 As Worksheet
Dim Sht2 As Worksheet
Dim myList_1 As Variant
Dim myList_2 As Variant
Dim i As Long
Dim j As Long
 
     Set Sht1 = Sheets("Sheet1")
     Set Sht2 = Sheets("Sheet2")
 
     '各シートのA列のデータを配列に格納
     Sht1.Select
     myList_1 = Sht1.Range(Cells(1, 1), _
        Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
 
     Sht2.Select
     myList_2 = Sht2.Range(Cells(1, 1), _
        Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
 
     '「Sheet1」 と 「Sheet2」 を比較
     For i = 2 To UBound(myList_1)
         For j = 2 To UBound(myList_2)
 
             '同じ値の場合、「Sheet1」 に色をつける
             If myList_1(i, 1) = myList_2(j, 1) Then
                Sht1.Cells(i, 1).Interior.Color = 65535
             End If
 
         Next j
     Next i
 
     '「Sheet1」 と 「Sheet2」 を比較
     For i = 2 To UBound(myList_2)
         For j = 2 To UBound(myList_1)
 
             '同じ値の場合、「Sheet2」 に色をつける
             If myList_2(i, 1) = myList_1(j, 1) Then
                Sht2.Cells(i, 1).Interior.Color = 65535
             End If
 
         Next j
     Next i
 
     Set Sht1 = Nothing
     Set Sht2 = Nothing
 
End Sub

回答
投稿日時: 21/06/03 22:32:23
投稿者: WinArrow
投稿者のウェブサイトに移動

総当たりチェックにするのか?
列ごとにチェックするkのか?
 
重複したセルに色を設定するだけならば
条件付き書式でできると思いますが・・・
VBAでループは意外と遅いですよ。

投稿日時: 21/06/03 22:47:29
投稿者: rragdoll

ありがとうございます。
総当たりでしょうか。
遅くても良いので何とかなりませんでしょうか。

回答
投稿日時: 21/06/03 23:36:03
投稿者: WinArrow
投稿者のウェブサイトに移動

条件付き書式を提案します。
  
Sheet1のA2:Z40を選択しておいて
  
条件付き書式をクリック
新しいルール
数式を使用して〜
ルールの内容(条件式)
=COUNTIF(Sheet2!$A$2;$Z$40,A2)>0
書式は好きなように
OK
  
これをSheet2側にも同じ考え方で設定すればよいでしょう。

回答
投稿日時: 21/06/03 23:40:28
投稿者: simple

同じく条件付き書式を推奨します。
 
どうしてもということなら、以下のようにそれと同じことをマクロにさせたらどうですか?
ただ、これだと、セルを変更するごとに重複チェックを忘れずに実行する必要があります。

Sub 重複チェック()
    Dim Sht1 As Worksheet
    Dim Sht2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim r    As Range

    Set Sht1 = Sheets("Sheet1")
    Set Sht2 = Sheets("Sheet2")
    Set rng1 = Sht1.Range("A2:Z40")
    Set rng2 = Sht2.Range(Sht2.Cells(1, 1), Sht2.Cells(Rows.Count, 1).End(xlUp))

    rng1.Interior.Pattern = xlNone
    For Each r In rng1
        If Application.CountIf(rng2, r) > 0 Then
            r.Interior.Color = 65535
        End If
    Next
    
    '後略(同様です)
End Sub    

なお、配列使用は、読み込みには驚くほどの効果は無いです。
一括書込には効果がありますが。

回答
投稿日時: 21/06/04 07:51:16
投稿者: WinArrow
投稿者のウェブサイトに移動

rragdoll さんの引用:

総当たりでしょうか。
遅くても良いので何とかなりませんでしょうか。

既にsimpleさんのご指摘にもありますが、
マクロで対応するには、
マクロの起動タイミングというものが有ります。
まとめて実行(例えば、保存する前)するにのか、
セルの変更が生じた時、実行するのかでも
マクロの作り方が変わってきます。
 
そのあたりを検討した上で、
>遅くてもよい
という発言は、後で後悔することに繋がります。

トピックに返信