[[20210423143529]]　『r.Interior.ColorIndex = c_cnt　でエラーがでまａx（kenN）　ページの最後に飛ぶ

『r.Interior.ColorIndex = c_cnt　でエラーがでます。』（kenN）

B列の重複を色分けしたいので下記のWEB記事のNo.5を候補に上げて
自分のシート構成に合わして一部コードを書き換えました。
（現在のコードは、最終部を参照下さい、）

https://oshiete.goo.ne.jp/qa/11651551.html

しかし、以下の部分で「実行エラー9：インデックスが有効範囲にありません。」のエラーがでます。
　 r.Interior.ColorIndex = c_cnt

なぜエラーが出るのか？
　　VBA初心者は、理由がわからないのです。

アドバイスをお願いします。

なお、
　「MIcrosoft Scripting Runtime」は、ライブラリファイルとして登録済みです。

Sub 重複データを値ごとに色わけ_2()
Dim myDic As Object
Dim r As Range
Dim rr As Range
Dim c_cnt As Integer
Dim Ws1 As Worksheet

Set Ws1 = Sheets("元DATA") '元のシート

Set myDic = CreateObject("Scripting.Dictionary")
Set rr = Ws1.Range("B1:B160")
rr.Interior.ColorIndex = xlNone

c_cnt = 3 '黒と白を避けたため

For Each r In rr
If r.Value <> "" And WorksheetFunction.CountIf(rr, r.Value) > 1 Then

    If Not myDic.Exists(r.Value) Then
        r.Interior.ColorIndex = c_cnt
        myDic.Add r.Value, c_cnt
        c_cnt = c_cnt + 1
    Else
        r.Interior.ColorIndex = myDic(r.Value)
    End If
End If
Next

Set rr = Nothing
Set myDic = Nothing

End Sub

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

c_cnt がColorIndexを超えるからじゃないですか？
（tkit） 2021/04/23(金) 14:45

tkitさん、アドバイスありがとうございます。

エラー発生時の、C_Cntの値は57と表示されています。

サンプリにB列に於いて
　　全く同じ値を適用したのがエラーの原因のようです。
　01-80行
　81-160行（0-80のコピペ）

多分、素人の想像では57以上違う場合は、色分けできないようです。
（サンプルでは、80箇所違う。）

これほど、重複することはほぼ無いと思われますが、
　　57を超えると塗替えでは無く幾つ重複があるか？
　　個数だけでもチェックできればと思いますが、良い方法はありますか　？

（今回サンプルは、Bが160行でしたが実際は2000行程度です。）

（kenN） 2021/04/23(金) 15:15

myDic.Countじゃだめなのかな？
（砂糖） 2021/04/23(金) 15:27

 参考まで。

https://officek.net/excelvba/v-range/vr-format/vrf-colorindexnum/
（通りすがり） 2021/04/23(金) 15:32

 色だけに情報をもたせるのは、
 職場における色覚多様性への配慮の観点や、
 Excelの使い勝手の上でも、やめた方がいいです。

 セルに識別番号を入力するほうが、後にデータとして使いやすいです
（´・ω・`） 2021/04/23(金) 16:38

みなさん、ありがとうございます

＞myDic.Countじゃだめなのかな？

色分けは、インデック番号が最大、56色しか利用できないので
下記のようなコードでエラーは回避できましたが、
myDic.Countは、エラー予定数の60になりません。

Sub 重複データを値ごとに色わけ_2()

Dim myDic As Object
Dim r As Range
Dim rr As Range
Dim c_cnt As Integer
Dim Ws1 As Worksheet
Dim ii As Single

Set Ws1 = Sheets("元DATA") '元のシート

Set myDic = CreateObject("Scripting.Dictionary")
Set rr = Ws1.Range("B1:B160")
rr.Interior.ColorIndex = xlNone

c_cnt = 3 '黒と白を避けたため

For Each r In rr
If r.Value <> "" And WorksheetFunction.CountIf(rr, r.Value) > 1 Then

    If Not myDic.Exists(r.Value) Then
        If c_cnt < 57 Then
            r.Interior.ColorIndex = c_cnt
            myDic.Add r.Value, c_cnt
            c_cnt = c_cnt + 1
        End If
    Else
        r.Interior.ColorIndex = myDic(r.Value)
    End If
End If
Next

ii = myDic.Count
MsgBox "mydisc.count = " & ii + 3

Set rr = Nothing
Set myDic = Nothing

End Sub

＞Excelの使い勝手の上でも、やめた方がいいです。

個人で利用する趣味の延長での運用なので気にしていません。
本当は、B列の横の列に「重複」の表示などがわかりやすいのでしょうが
　既にC列は他で利用しているのでコードを書き換えないで重複できないか？と考えたわけです。

＞セルに識別番号を入力するほうが、後にデータとして使いやすいです

マクロ初心者は、アドバイスを受けても中々ピンときません。
どういう事でしょうか　？

（kenN） 2021/04/23(金) 17:24

＞セルに識別番号を入力するほうが、後にデータとして使いやすいです
マクロ初心者は、アドバイスを受けても中々ピンときません。
どういう事でしょうか　？

検索するですね。^^

VBA, 識別番号, 色, セルの色を取得する, ユーザー定義関数

等々を適当にスペース入れて2～3個いれたら
なにかは出てくるですよ。
（にゃん） 2021/04/23(金) 17:47

 では、お好きなようにどうぞ。
 ColorIndexじゃなくて、Color使えばセルの色は書式の数の限界まで塗り分けられます
 目で判別できるかどうかは別ですが。

    Sub sample()
      Const nCOlor = 80
      Dim H As Double, S As Double, V As Double
      Dim d As Double
      d = 1 / nCOlor
      For i = 1 To nCOlor
         H = d * (i - 1)
         S = 1
         V = 1
         Cells(i, 1).Interior.Color = hsv2rgb(H, S, V)
      Next

    End Sub

    Function hsv2rgb(ByVal H As Double, ByVal S As Double, ByVal V As Double) As Long
        Dim i As Integer, f As Double
        Dim R As Double, G As Double, B As Double
        H = H * 6
        i = Int(H)
        f = H - i
        k1 = 1 - S
        k2 = 1 - S * f
        k3 = 1 - S * (1 - f)
        Select Case i
           Case 0: R = V:        G = V * k3:    B = V * k1
           Case 1: R = V * k2:   G = V:         B = V * k1
           Case 2: R = V * k1:   G = V:         B = V * k3
           Case 3: R = V * k1:   G = V * k2:    B = V
           Case 4: R = V * k3:   G = V * k1:    B = V
           Case 5: R = V:        G = V * k1:    B = V * k2
        End Select
        hsv2rgb = RGB(R * 256, G * 256, B * 256)
    End Function
（´・ω・`） 2021/04/23(金) 19:00

コメント返信：

[ 一覧(最新更新順) ]

[[20210423143529]] 『r.Interior.ColorIndex = c_cnt でエラーがでまａx（kenN） ページの最後に飛ぶ

[[20210423143529]]　『r.Interior.ColorIndex = c_cnt　でエラーがでまａx（kenN）　ページの最後に飛ぶ