[[20140912193520]]　『重複しているデータの色付け』（秋）　ページの最後に飛ぶ

『重複しているデータの色付け』（秋）

はじめまして、
まだまだ初心者ですので簡単なことを聞いてしまうかもしれませんが、教えて頂けましたら幸いです。

  A   B    　　C　　　D　　E　F　　G　　　H　　　　I
1                        タイトル
2＿  名前　ふりがな　番号  ＿ ＿ 名前　ふりがな　番号
3　　木村　　きむら　12          佐藤　　さとう　13
4    佐藤　　さとう　21　　　　　田中　　たなか　30
5　　木村　　きむら　44

A～D、F～Iで作ってある2つの表があります(Eは表の間のスペースです)
1行目にはタイトル、2行目には見出しがあり、3行目以降に内容が入っています。
AとFはCとHで重複があった場合に色をつける何も入っていないセルです。
下記のコードでCのふりがなが重複している場合、Aに色をつけることには成功したのですが、
CだけでなくHも含めて結果を出すにはどうすればいいのでしょうか？
(今の状態ではA3とA5に色がつきますがA4とF3にもつくようにしたいです)

ちなみに同じ形式で平均6程のシートのファイルが10程度あります。

よろしくお願いします。

Sub tyoufuku()

    Dim lastrow  As Integer
    Dim i        As Integer
    Dim j        As Integer
    Dim name     As String

    ActiveSheet.Range("C3").End(xlDown).Select
    lastrow = ActiveCell.Row

    For i = 3 To lastrow - 1

    name = ActiveSheet.Cells(i, 3).Value
        For j = i + 1 To lastrow
            If name = ActiveSheet.Cells(j, 3).Value Then
            ActiveSheet.Cells(i, 1).Interior.ColorIndex = 44
            ActiveSheet.Cells(j, 1).Interior.ColorIndex = 44
            End If
        Next
    Next
End Sub

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

 二重ループはデータ量が多くなると急激に遅くなりますし、今回のような複数列処理では
 複雑な処理になりそうです。

 今回のようなケースでは辞書を利用すると、比較的シンプルにできるかと思います。
 一応のサンプルです。

 Sub Sample()
    Dim シート As Worksheet
    For Each シート In ThisWorkbook.Worksheets '// とりあえず自ブックを処理
        重複チェック シート
    Next
 End Sub

 Sub 重複チェック(対象シート As Worksheet)
    対象シート.Columns("A:A").Interior.ColorIndex = 0
    対象シート.Columns("F:F").Interior.ColorIndex = 0

    Dim チェック用辞書
    Set チェック用辞書 = CreateObject("Scripting.Dictionary")

    Dim 最終行 As Long
    最終行 = 対象シート.Cells(Rows.Count, "C").End(xlUp).Row

    Dim 行 As Long
    Dim 名前 As String
    Dim マークセルアドレス As String
    For 行 = 3 To 最終行
        名前 = 対象シート.Cells(行, "C").Value
        マークセルアドレス = 対象シート.Cells(行, "A").AddressLocal(False, False)
        If チェック用辞書.exists(名前) = False Then
            チェック用辞書(名前) = マークセルアドレス
        Else
            チェック用辞書(名前) = _
                チェック用辞書(名前) & "," & マークセルアドレス
        End If
    Next

    最終行 = 対象シート.Cells(Rows.Count, "H").End(xlUp).Row

    For 行 = 3 To 最終行
        名前 = 対象シート.Cells(行, "H").Value
        マークセルアドレス = 対象シート.Cells(行, "F").AddressLocal(False, False)
        If チェック用辞書.exists(名前) = False Then
            チェック用辞書(名前) = マークセルアドレス
        Else
            チェック用辞書(名前) = _
                チェック用辞書(名前) & "," & マークセルアドレス
        End If
    Next

    Dim 名前キー
    For Each 名前キー In チェック用辞書.keys
        If InStr(チェック用辞書(名前キー), ",") > 0 Then '// 複数あれば , があるはず
            対象シート.Range(チェック用辞書(名前キー)).Interior.ColorIndex = 44
        End If
    Next
 End Sub

（Mook） 2014/09/12(金) 21:03

思っていた以上のものを作って頂きありがとうございます。
(シート1つずつの処理しか考えていませんでした)

辞書機能は恥ずかしながら初めて知りました。
使えるとすごい便利そうなので、難しそうですがこれを機会に勉強しようと思います。

本当にありがとうございました。
（秋） 2014/09/13(土) 14:03

 辞書の使い方もそうですが、開いているブック全部を処理するということも可能です。
 その中で、条件判定をして対象シートだけ処理するというようにすると、一括ですべてを
 処理できるようになるかと思います。
（Mook） 2014/09/13(土) 15:15

コメント返信：

[ 一覧(最新更新順) ]

[[20140912193520]] 『重複しているデータの色付け』（秋） ページの最後に飛ぶ

[[20140912193520]]　『重複しているデータの色付け』（秋）　ページの最後に飛ぶ