[[20150629163826]]　『重複した行に色を付けたい』（さんま）　ページの最後に飛ぶ

『重複した行に色を付けたい』（さんま）

重複した行に色を付けたいです。

重複条件はＡ列、Ｂ列、Ｆ列、Ｇ列がすべて同じ行がある場合、その行に色を付けたいです。

重複条件を調べる範囲も決まっておらず、Ａ～Ｇ列の使用しているセル範囲を自動的に検出したいです。

エクセルのデータタブの重複条件の削除という機能はあるのですが、削除しないで
色を付けたいのです。

VBAを教えてください。

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

条件付き書式で、「=AND($A1=$B1,$F1=$G1,$A1=$F1)」とするだけでも良いと思いますが？
（???） 2015/06/29(月) 17:18

行の比較でしょうか？

 Sub test()
    Dim dic As Object
    Dim v
    Dim i As Long
    Dim s As String
    Dim k

    Set dic = CreateObject("scripting.dictionary")

   With Range("a1").CurrentRegion
        .Interior.ColorIndex = xlNone
        v = .Resize(, 7).Value
        For i = 1 To UBound(v)
            s = v(i, 1) & v(i, 2) & v(i, 6) & v(i, 7)
            If Not dic.exists(s) Then
                Set dic(s) = .Rows(i)
            Else
                Set dic(s) = Union(dic(s), .Rows(i))
            End If
        Next

        For Each k In dic.keys
            If dic(k).Count > .Columns.Count Then
                dic(k).Interior.ColorIndex = 3
            End If
        Next
    End With

 End Sub

（マナ） 2015/06/29(月) 21:58 修正22:50

 行の比較なら

 Sub test()
    Dim e, txt As String
    With Cells(1).CurrentRegion
        .Interior.ColorIndex = xlNone
        For Each e In Array("a", "b", "f", "g")
            txt = txt & "," & e & "1:" & e & .Rows.Count & "," & e & "1:" & e & .Rows.Count
        Next
        For Each e In Filter(Evaluate("transpose(if(countifs(" & Mid$(txt, 2) & ")>1,row(1:" & .Rows.Count & "),char(2)))"), Chr(2), 0)
            .Rows(e).Interior.Color = vbRed
        Next
    End With
End Sub
（seiya） 2015/06/29(月) 22:27

？？？様、マナ様、seiya様、返信ありがとうございます。

毎回使用しているセル範囲を囲むのも範囲が広いのでたいへんだったのでVBAに出きたらな～と思っていました。

マナ様、seiya様のＶＢＡをそれぞれ試したところ、同じように望んでいた結果になりました。

？？？様の方法もあるのですね！！！

いろいろと教えて頂いて有難うございました。

感謝申し上げます。

（さんま） 2015/06/30(火) 08:04

コメント返信：

[ 一覧(最新更新順) ]

[[20150629163826]] 『重複した行に色を付けたい』（さんま） ページの最後に飛ぶ

[[20150629163826]]　『重複した行に色を付けたい』（さんま）　ページの最後に飛ぶ