重複数字の数に応じてセルに色をつける。

質問

このカテゴリーのエクセルの達人の方々に質問です。
どなたか回答して頂ける方がお見えでしたらよろしくお願いします。
（ちゃんとした回答ではなく、文句やクレーム等を混ぜた記載はご遠慮ください。
　また私の質問が気に入らない場合は無視して頂ければ結構です。）
【質問】
　添付図のとおり、１列×２５行の中に数字が１～31まであり、
　重複数字を含んで昇順に並んでおり、それが４列あります。
　１列毎に数字を見て以下の条件にあえばセルを塗り潰します。
　　２個重複⇒セルを黄色に塗り潰す。
　　３個重複⇒セルを青色に塗り潰す。
　　４個重複⇒セルを緑色に塗り潰す。
　　５個重複⇒セルを赤色に塗り潰す。

上記を実現する方法をＶＢＡで実現する方法が知りたいです。

【注意事項】
　　・1列×２５行の中にある数字の並びは毎回異なります。
　　・1列×２５行の中に重複数字が無い場合があります。（例：Ａ列）
　　・ＶＢＡで実現する方法～、と書きましたが、
　　　同様のことが他の方法でも実現できればそれを教えて下さい。
　　・使用するエクセルは２０２１です。

以上、よろしくお願いします。

回答No.2

kkkkkm · ベストアンサー

条件つき書式で塗る方法
A1からA25まで選択した状態で
数式を使用して
=COUNTIF(A$1:A$25,A1)=2
として色の設定を黄色
あとは式を変えてそれぞれ新しい書式設定で
=COUNTIF(A$1:A$25,A1)=3
色の設定を青色
=COUNTIF(A$1:A$25,A1)=4
色の設定を緑色
=COUNTIF(A$1:A$25,A1)=5
色の設定を赤色
にしてください。

お礼

回答ありがとうございます。 ＶＢＡ、条件付き書式の両方試してみました。想定結果になりました。ありがとうございます。また、質問みかけたら回答いただけると助かります。

Powered by GRATICA

回答No.3

kkkkkm

セルに色が塗られていても色の設定は条件付き書式が優先されます。
条件付き書式を設定した後でマクロを実行しても色が変わらないように見えますが、たとえばB列の7を消すとマクロで塗った色が見えます。

回答No.1

kkkkkm

質問の言葉の色にしています。実際の画像の色にしたい場合は、マクロの記録でセルに色を付けてその時に
.Color = 5296274
のようになっているところの数値を当てはめてください。

Sub Test()
Dim mRng As Range
Range("A1:D25").Interior.ColorIndex = xlNone
For Each mRng In Range("A1:D25")
Select Case WorksheetFunction.CountIf(Range(Cells(1, mRng.Column), Cells(25, mRng.Column)), mRng.Value)
Case 2
mRng.Interior.Color = vbYellow
Case 3
mRng.Interior.Color = vbBlue
Case 4
mRng.Interior.Color = vbGreen
Case 5
mRng.Interior.Color = vbRed
Case Else
End Select
Next
End Sub