[[20160330093655]]　『重複する値に色を付けたい』（さんま）　ページの最後に飛ぶ

『重複する値に色を付けたい』（さんま）

エクセルの重複している値に色を付けたいです。

ＶＢＡを作成しましたが、実行すると空白セルが色が染まってしまうだけです。

どこを直せばいいのでしょうか？？？

それとＣ列の３７行め迄となっていますが、これを最終行まで適用するにはどうしたらよいでしょうか？？？

Sub 重複行を色付け()
For i = 1 To Sheets.Count

    Sheets(Sheets(i).Name).Select
    Call 重複を探す
 Next i

 End Sub
Sub 重複を探す()

Dim RetRange As Range

 Range("C6:C37").Select
 For i = 6 To 37
     Set RetRange = Selection.Find(What:=Cells(i, 3).Value, _
                           after:=ActiveCell, LookIn:=xlFormulas, _
                           LookAt:=xlPart, SearchOrder:=xlByRows, _
                           SearchDirection:=xlNext)
     If Not RetRange Is Nothing Then
         If RetRange.Address <> Cells(i, 3).Address Then
              RetRange.Interior.ColorIndex = 6
              Cells(i, 3).Interior.ColorIndex = 6
         End If
     End If
 Next

End Sub

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

 コードとしては無駄がたくさんある記述になっていますが、色つけということに関しては
 重複するセルには色が塗られますよ。　空白セルにも色が塗られますけど。

 空白セルを除外したいなら　For i = 6 To 37　の次に　If Not IsEmpty(Cells(i, 3).Value) Then といったものをいれて
 値があるものだけを検索対象にしたらいいですね。

 また、C6からC列データ最終セルまで　と規定するなら　 Range("C6",Range("C" & Rows.COunt).End(xlUp)).Select
 として試してください。

（β） 2016/03/30(水) 09:58

 上級者から見れば私のコードも無駄が多いと思われそうですが･･･

 Sub 重複行を色付け()

     Dim i As Long, r As Long, LastRow As Long

     Application.ScreenUpdating = False

     For i = 1 To Sheets.Count
         With Sheets(i)
              LastRow = .Cells(Rows.Count, 3).End(xlUp).Row
              For r = 6 To LastRow
                  If Application.CountIf(.Range("C6:C" & LastRow), .Cells(r, 3).Value) > 1 Then .Cells(r, 3).Interior.ColorIndex = 6
              Next
         End With
     Next

     Application.ScreenUpdating = True

 End Sub
（se_9） 2016/03/30(水) 10:04

 私なら素直に条件付き書式で

 Sub test()
    Dim ws As Worksheet
    For Each ws In Worksheets
        With ws.Range("c6", ws.Range("c" & Rows.Count).End(xlUp))
            .FormatConditions.Delete
            .FormatConditions.Add 2, , "=countif(" & .Address & ",c6)>1"
            .FormatConditions(1).Interior.Color = vbYellow
        End With
    Next
End Sub
（seiya） 2016/03/30(水) 10:14

β様、se_9様、seiya様、コメント有難うございます。

皆さま様の方法をそれぞれ試したのですが、どれも思った通りに出来ました。

前回全シートに適用するVBAで

For i = 1 To Sheets.Count

を使用して作成したのですが、どうしても全シートに適用できなかったんでこの様な形にしてみたんです。

でもse_9様のVBAではうまく動作しました。

有難うございました。

seiya様、条件付き書式でもできるんですね（＾０＾）！！
勉強になりました。

皆さま有難うございました。

（さんま） 2016/03/30(水) 10:23

 無事解決したようなのでもう見ていないかもしれませんが

 ＞どうしても全シートに適用できなかったんで

 Sheets(Sheets(i).Name).Select
 Call 重複を探す

 このコードでは1枚目のシートを選択したら「重複を探す」コードに飛んでしまうので
 当然2枚目以降の処理はされません。あと今回のこととは関係ありませんが
 Sheets(Sheets(i).Name).Select は Sheets(i).Select でもいいと思います。
（se_9） 2016/03/30(水) 10:33

コメント返信：

[ 一覧(最新更新順) ]

[[20160330093655]] 『重複する値に色を付けたい』（さんま） ページの最後に飛ぶ

[[20160330093655]]　『重複する値に色を付けたい』（さんま）　ページの最後に飛ぶ