[[20210710065150]] 『複数種類の重複を異なる色で表示する』(なつふく) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『複数種類の重複を異なる色で表示する』(なつふく)

データの重複が複数種類ある場合、それらを異なる色で表示したいです。

例えば、

A
B
C
B
A

というデータがある場合、
条件付き書式の「セルの強調表示ルール」→「重複する値」で色付けをすると、Aの重複もBの重複も同じルールに基づいて同じ色が付けられますが、これを例えばAの重複は赤色、Bの重複は青色、のように異なる色で表示できるようにしたいです。

調べた限りではマクロを使えばそのような表示ができるようですが、それだとマクロを実行してからでないと色分けがなされず、条件付き書式のようにデータが入力された段階でリアルタイムに色分けがされるのが理想です。

このようなことは可能でしょうか。

< 使用 Excel:Excel2019、使用 OS:Windows10 >


 >マクロを実行してからでないと色分けがなされず
 そのマクロをWorksheetオブジェクトのChangeイベントで実行するのはナシですか?

(麦芽豆乳) 2021/07/10(土) 07:36


 少々かぶったが。
 イベントプロシージャを使えばセルの入力時にマクロを実行できる。
 シートタブを右クリックしてコードの表示を選択。
 表示されたVBE画面で

 Private Sub Worksheet_Change(ByVal Target As Range)

 End Sub
 の間にマクロを記述するとそのマクロはそのワークシートでセルに値を入力した際に実行される。

 もし、条件付き書式で行う場合は例えばA列に設定するとしてA列を選択して条件付き書式の
 数式を使用して書式設定するセルを設定する、で数式に
 =AND(COUNTIF(A:A,A1)>1,MATCH(A1,A:A,0)=1) 
 書式で塗りつぶしの色を設定、新しいルールで
 =AND(COUNTIF(A:A,A1)>1,MATCH(A1,A:A,0)=2)
 で違う色を設定、ルールの追加で
 =AND(COUNTIF(A:A,A1)>1,MATCH(A1,A:A,0)=3)
 で違う色を設定
 …
 と繰り返すことで重複があり、重複の一番上のセルが1行目、2行目、3行目…
 で違う色を付けれる。
(ねむねむ) 2021/07/10(土) 07:41

2パターンのやり方での回答ありがとうございます。
試してみましたが、うまくいかないので教えてください。

●マクロの方
マクロがよくわかっていないのですが、ネットにあった下記コードをコピペして使ってみようと考えております。これのどこに「Private Sub Worksheet_Change(ByVal Target As Range)」「End Sub」を挿入すればよいのでしょうか。一番上に「Private Sub Worksheet_Change(ByVal Target As Range)」を入れて、「End Sub」はもう書かれているので入れずにやってみましたがうまくいきませんでした。また、「Sub ColorCompanyDuplicates()」を消して代わりに「Private Sub Worksheet_Change(ByVal Target As Range)」
を入れてみてもダメでした。
あと、下のコードで設定されている色が原色なので設定を変更したいのですが、どの部分が色設定に該当するかがわかりません。教えていただけると幸いです。

Sub ColorCompanyDuplicates()
'Updateby Extendoffice

    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xChar As String
    Dim xCellPre As Range
    Dim xCIndex As Long
    Dim xCol As Collection
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
    Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    xCIndex = 2
    Set xCol = New Collection
    For Each xCell In xRg
      On Error Resume Next
      xCol.Add xCell, xCell.Text
      If Err.Number = 457 Then
        xCIndex = xCIndex + 1
        Set xCellPre = xCol(xCell.Text)
        If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
        xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
      ElseIf Err.Number = 9 Then
        MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
        Exit Sub
      End If
      On Error GoTo 0
    Next
End Sub

●条件付き書式の方
お教えいただいた
=AND(COUNTIF(A:A,A1)>1,MATCH(A1,A:A,0)=1)
の式は、A1セルと同じ値がA2以降の行に存在した場合に設定した色を表示する、という理解であっていますでしょうか。試しに
=AND(COUNTIF(A:A,A1)>1,MATCH(A1,A:A,0)=3)
まで設定して、A1を空白にして、A2とA3を重複させたところ、
=AND(COUNTIF(A:A,A1)>1,MATCH(A1,A:A,0)=2)
で設定した色がA2とA3で出てきました。

今回、B5からB14までの縦方向に並ぶ10個のセルで重複の色分けをしたいのですが、その場合は
=AND(COUNTIF(B5:B14,B5)>1,MATCH(B5,B5:B14,0)=1)
で色設定をして、
その後はどのようにすればよいのでしょうか。MATCHを9まで設定しないといけないのでしょうか。

(なつふく) 2021/07/10(土) 08:38


 =AND(COUNTIF(B$5:B$14,B5)>1,MATCH(B5,B$5:B$14,0)=1)
 としてMATCH関数を9まで設定してみてくれ。

(ねむねむ) 2021/07/10(土) 08:45


やはり9まで必要なのですね。
やってみまして上手くいきました。
ご教授くださりありがとうございました!
(なつふく) 2021/07/10(土) 10:32

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.