[[20130214110527]]　『重複チェックを行いたい』（ミカン）　ページの最後に飛ぶ

『重複チェックを行いたい』（ミカン）

 お世話になります。
 表題の件で悩んでいます。

        B        C       D
 7   コード     名称    金額

 8   AAAAAA     ○○○   100

 9   BBBBBB     △△△   200

 10  AAAAAA     □□□   300

 11  CCCCCC　　 ×××   400

 上記のような表があります。
 この時、B列に重複チェックをかけ、重複しているものでも下にあるセルに色をつけたいです。
 (上記の表ではB10のセルに色をつけたいです。)
 Countifで処理を書けばよいのでしょうが、範囲指定などでこんがらがってしまいます。

 難しくはないと思いますが良い案が思い浮かびません。
 宜しくお願いします。

 XP Excel2002

 B8セルからB11セルを選択した状態で 書式 → 条件付き書式 
 数式が =COUNTIF(B$8:B8,B8)>1
 書式をクリックしてパターンタブから色を選択

 でどうでしょうか？

 (se_9)

 se_9さんお世話になります。

 書き忘れていましたがVBAでやりたいのです。

 現在途中までできているのが下記の処理です。
 For i = 8 to 最下行
   コード =　Cells(i,2)
   Application.WorksheetFunction.CountIf(Range("B8:B" & 最下行), コード) < 1

 Next i

 これだと、一番最初に重複しているセルに色がついてしまうんです…
 (ミカン)

 Application.WorksheetFunction.CountIf(Range("B8:B" & i), コード) > 1
 かな？

 (se_9)

 こんな方法も

 Sub test()
    Dim x
    With Range("b1", Range("b" & Rows.Count).End(xlUp))
        .Interior.ColorIndex = xlNone
        x = Filter(.Parent.Evaluate("transpose(if(countif(offset(" & .Address & _
        ",0,0,row(1:" & .Rows.Count & "))," & .Address & ")>=2,""b""&row(" _
        & .Address & "),char(2)))"), Chr(2), 0)
    End With
    If UBound(x) > -1 Then Range(Join$(x, ",")).Interior.Color = vbRed
End Sub
(seiya)

 se_9さん
 お世話になります。

 単純に一番上からコードの対象行までを検索範囲にすればよかったんですね

 ありがとうございました。

 seiyaさん
 お世話になります。
 seiyaさんのコードはFilter関数を使ってセルの値を入れてチェックする方法でしょうか。
 Char(2)というのはあまり使わない記号のようですがなぜこれを使用しているのでしょうか。

 (ミカン)

 C1:CのB列最終行まで選択して、

 =IF(COUNTIF(OFFSET(B1:B23,0,0,ROW(B1:B23)),B1:B23)>=2,"b"&ROW(B1:B23),"")
 を入力して Ctrl + Shift + Enter で確定。
 B1:B23　の 23は実際の数値にする。

 C列に出現するのが条件に合ったもののセルアドレス
 その配列をTranspose関数で 一次元配列に変換したのちFilter関数で
 該当データのみ抽出
 (実際のコードでは、条件に合わない行をChar(2)として、それ以外を抽出)
 なぜChar(2)?
 Filter関数は部分一致したものを対象としてしまうので、殆ど使用しない文字
 を使用しているだけ

 これをメモリ上で展開したもの
 (seiya)

 Filterとは

 =IF(COUNTIF(OFFSET(B1:B23,0,0,ROW(B1:B23)),B1:B23)>=2,"b"&ROW(B1:B23),"")
 を入力して Ctrl + Shift + Enter で確定。

 と同じだったんですね！
 勉強になりました。

 (ミカン)

 一応、後で見る人のために
 その理解の仕方は、間違い。

 Filter 関数は一次元配列からマッチする又は、マッチしない要素のみを取り出す関数。

 Evaluateメソッドで計算された結果の配列(二次元配列)から、Filter関数で目的の
 要素のみを抽出するには一次元配列に変換する必要があるので、Transpose関数を使用。

 その後、Join関数で抽出された配列の要素をカンマで結合して、一気に色を付ける。
 (seiya)

 解決後？ ですが、別法で

  Sub Try1()
    Dim dic As Object
    Dim c As Range
    Dim ss As String

    Set dic = CreateObject("Scripting.Dictionary")
    With Range("B8", Cells(Rows.Count, 2).End(xlUp))
        .Interior.ColorIndex = xlNone
        For Each c In .Cells
            ss = c.Value
            If dic.Exists(ss) Then '重複あり
                dic(ss) = c.Address  'アドレスを上書き
            Else
                dic(ss) = Empty
            End If
        Next
    End With

    Dim e As Variant
    For Each e In dic.Items()
        If Len(e) Then
            Range(e).Interior.Color = vbYellow
        End If
    Next
 End Sub

 (kanabun)

 すみません、勘ちがいしてました。
 何回か重複していたばあい、↑はその最後のセルにだけ色塗りしてました。（下記例）
 ------------
 8    A
 9    B
 10   A
 11   C
 12   A ●
 13   B ●

 2度目の出現以降すべての重複するセルに色塗りなら、こうでした

 Sub Try2()
    Dim dic As Object
    Dim c As Range, r As Range
    Dim ss As String

    Set dic = CreateObject("Scripting.Dictionary")
    With Range("B8", Cells(Rows.Count, 2).End(xlUp))
        .Interior.ColorIndex = xlNone
        For Each c In .Cells
            ss = c.Value
            If dic.Exists(ss) Then '重複あり
                If r Is Nothing Then
                    Set r = c
                Else
                    Set r = Union(r, c)
                End If
            Else
                dic(ss) = Empty
            End If
        Next
    End With

    If Not r Is Nothing Then
        r.Interior.Color = vbYellow
    End If
 End Sub

 -------------
 8    A
 9    B
 10   A ●
 11   C
 12   A ●
 13   B ●

  (kanabun)

コメント返信：

[ 一覧(最新更新順) ]

[[20130214110527]] 『重複チェックを行いたい』（ミカン） ページの最後に飛ぶ

[[20130214110527]]　『重複チェックを行いたい』（ミカン）　ページの最後に飛ぶ