[[20040403064346]]　『重複した数字の検索について』（古代進）　ページの最後に飛ぶ

『重複した数字の検索について』（古代進）

一つの表のなかに、いくつ重複した数字があるのかを一発で確かめる方法を教えてください。１つづつであれば検索でできますが、２つ以上を色別でとかでできないでしょうか？

Excel2000or2003
WindowsXP

 表のレイアウトを教えて下さい。

  (INA)

 -------------------------------------------------------
 | 010 | 543 | 264 | 874 | 921 | 012 | 566 | 234 | 432 |
 -------------------------------------------------------
 | 544 | 678 | 987 | 123 | 648 | 782 | 010 | 672 | 275 |
 -------------------------------------------------------
 | 452 | 347 | 761 | 943 | 275 | 348 | 012 | 678 | 574 |
 -------------------------------------------------------
 | 648 | 579 | 649 | 349 | 950 | 579 | 432 | 677 | 544 | 
 -------------------------------------------------------
 | 468 | 927 | 654 | 320 | 100 | 571 | 696 | 347 | 222 |
 -------------------------------------------------------

上記のような感じ、ようするに沢山割り振った数字に重複が
無いかを確認するときに使用したいのです。
なにとぞ御指南を・・・・(古代進）

 A1：I5選択して、書式メニューの「条件付書式設定」で[数式が][=COUNTIF($A$1:I5,A1)>1 ]
[書式]でフォント色を赤にします。これで重複数字は赤くなります。
　
    A     B        C        D        E         F        G        H        I        J        K
 1 010	543	264	874	921	012	566	234	432		
 2 544	678	987	123	648	782	010	672	275		
 3 452	347	761	943	275	348	012	678	574		
 4 648	579	649	349	950	579	432	677	544		
 5 468	927	654	320	100	571	696	347	222		
 6 1	1	1	1	1	1	1	1	2	2	9
 7 1	1	1	1	2	1	2	1	2	0	0
 8 1	1	1	1	1	1	2	2	1	0	0
 9 1	1	1	1	1	2	1	1	2	0	0
10 1	1	1	1	1	1	1	2	1	0	0
11 									重複数	9
 A6:I10を選択して、A6に =COUNTIF($A$1:A$5,A1)　と入力し、Ctrl+Enterで確定します。
1は重複なし、2は重複数２個目
J6の式は =MAX(A6:I10,0)     K6の式は =COUNTIF($A$6:$I$10,J6)
J7の式は =IF(J6>2,J6-1,0)   K7の式は =IF(J7=0,0,COUNTIF($A$6:$I$10,J7)-SUM($K$6:K6))
J7:K7をK10まで下方コピーします。 J11の式は =SUM(K6:K10) で重複組数が表示されます。
質問に適合するように作っただけで、不具合があります。条件（列に重複データが無い場合）
「条件付書式設定」で
条件1　[数式が][=COUNTIF($A$1:I5,A1)=2][書式]でフォント色を赤にします。[追加]
条件2　[数式が][=COUNTIF($A$1:I5,A1)=3][書式]でフォント色を青にします。として
無料ダウンロードのColor関数で　=UFClrCntfc(A1:I5,3)/2 や　=UFClrCntfc(A1:I5,5)/3　は機能しません。
但し、赤文字を選択してフォント色を赤に指定すると機能します。同様に青文字選択し、青指定
取り合えず回答が出るまでの繋ぎとさせて頂きます。＿(シニア)

ちょっとややこしそうですが、やってみます。
もっと簡易な方法ありましたら、よろしくお願いします。（古代進）

 束の間のレスタイム
 [Alt]+[F11]でVBE、Open
 「挿入」→「標準モジュール」選択
 下のコードコピペ
 [Alt]+[Q]でエクセルにCome　Back

 [Alt]+[F8]でcodayを実行
 範囲の入力はマウスで範囲をなぞるも良し、範囲を記入するも良し。
 １回重複は黄色、２回は緑、それ以上はマゼンダになってますが、色は好きに変えて
 くだはい。
 またセルの塗り潰しやなしに、フォントの色をかえたいばやいは
 Interior.ColorindexをFont.Color.Colorindexに書き換えればOKです。
 　　　　　ほな...（弥太郎）
 '-------------------
 Sub coday()
    Dim dbl As Integer, t As Integer, f As Integer, x As Integer
    Dim y As Integer, j As Integer, d As Integer, n As Integer
    Dim b As Integer
    Dim tbl As Range
    Dim data As Long

    Dim colorcell() As String
    Set tbl = Application.InputBox(prompt:="検索したい範囲を指定して下さい", _
                        Title:="範囲の指定", Type:=8)
    tbl.Interior.ColorIndex = xlNone
    f = 1

    For x = 1 To tbl.Rows.Count * tbl.Columns.Count - 1
        t = t + 1
        If t > tbl.Rows.Count Then
            t = 1
            f = f + 1
        End If
        On Error Resume Next
        dbl = Application.WorksheetFunction.CountIf(tbl, tbl.Cells(t, f))
        If dbl > 1 And tbl.Cells(t, f).Interior.ColorIndex = xlNone Then
            data = tbl.Cells(t, f)
            adrs = tbl.Cells(t, f).Address
            j = t
            d = t

            For i = f To tbl.Columns.Count
                If dbl = b + 1 Then Exit For
                    For n = 1 To tbl.Rows.Count - d
                        If dbl = b + 1 Then Exit For
                        ReDim Preserve colorcell(b)
                        If tbl.Cells(t + j - d + n, i).Interior.ColorIndex = xlNone Then
                                                            If data = tbl.Cells(t + j - d + n, i) Then
                                    colorcell(b) = tbl.Cells(t + j - d + n, i).Address
                                    b = b + 1
                                End If
                        End If
                    Next n
                    j = -t
                    d = 0
            Next i
                If b > 0 Then

                    For y = 0 To UBound(colorcell)
                        Select Case b
                            Case 1
                                Range(adrs).Interior.ColorIndex = 6
                                Range(colorcell(y)).Interior.ColorIndex = 6
                            Case 2
                                Range(adrs).Interior.ColorIndex = 4
                                Range(colorcell(y)).Interior.ColorIndex = 4
                            Case Else
                                Range(adrs).Interior.ColorIndex = 7
                                Range(colorcell(y)).Interior.ColorIndex = 7
                        End Select
                    Next y
        End If
        b = 0
        End If
    Next x
    On Error GoTo 0
End Sub

コメント返信：

[ 一覧(最新更新順) ]

[[20040403064346]] 『重複した数字の検索について』（古代進） ページの最後に飛ぶ

[[20040403064346]]　『重複した数字の検索について』（古代進）　ページの最後に飛ぶ