エクセルでの文字色を数える関数に関して。。。

Question

エクセルのセル内の文字色に関してのマクロを下記の通り書きました。

Function SpecialCell(targetRange As Range, _
intColor As Integer) As Integer
'赤は3，緑は4，青は5，黄は6
Dim myCell As Range

For Each myCell In targetRange
If myCell.Font.ColorIndex = intColor _
Or myCell.Interior.ColorIndex = intColor Then
SpecialCell = SpecialCell + 1
End If
Next
End Function

その後答えを求めるセルに
=SpecialCell(D5:D125,3)

これはちゃんと表示できます。

しかし、
=SpecialCell(D10,D8,D29,D49,D51,D57,3)

このようにセルの個別ごとに求めようとすると
#VALUE!

が出ますので引数が間違っているのだとは思うのですが、
この場合はどうすればよろしいでしょうか？

また、セル内に複数の色つき文字がある場合、
例えば同一セル内に
(1)(2)(3)
とあって、
(1)が赤
(2)が青
(3)がピンク

とした場合、
=SpecialCell(D5:D125,3)
これでは０と出てきてしまいます。。。
この場合はどういう風に数式をいれればよいのでしょうか？

以上2点ほどご教授いただけると助かります。
よろしくお願いいたします。。。

kybo · Answer

コードは以下のようにして、

Function SpecialCell(intColor As Integer, ParamArray targetRange() As Variant) As Integer
'赤は3，緑は4，青は5，黄は6
    Dim myCell As Range, I As Integer
    For I = 0 To UBound(targetRange)
    For Each myCell In targetRange(I)
        If myCell.Font.ColorIndex = intColor _
            Or myCell.Interior.ColorIndex = intColor Then
            SpecialCell = SpecialCell + 1
        End If
    Next
    Next
End Function

セルには、

=SpecialCell(3,D10,D8,D29,D49,D51,D57)

のように入力してみください。

kmetu · Answer

=SpecialCell((D10,D8,D29,D49,D51,D57),3)

セルの指示を括弧で囲むといけますね。

Cor_moriyan · Answer

このマクロは、ご自身で作成されたものですか？

> =SpecialCell(D10,D8,D29,D49,D51,D57,3)

Functionで定義している引数が２つ(targetRange As Range, intColor As Integer)しかないのに、それ以上書いてもエラーになるだけです。上記の様な指定をしたいなら、マクロを修正するしかありません。

> セル内に複数の色つき文字がある場合

マクロ内では、セル全体の文字書式(.Font.ColorIndex)しか判定していませんので、これもマクロを修正しないとダメです。

ご質問の内容は「どういう風に数式をいれればよいのでしょうか？」なので、セルに入れる数式の方法ですが。。。　残念ながら、回答としては「質問者さんのやりたい事が出来るマクロでは無い」です(^^;

マクロを直すとすれば、こういう感じでしょうか。

Function SpecialCell(RangeString As String, intColor As Integer) As Integer
　　'赤は3，緑は4，青は5，黄は6
　　Dim TargetRange As Range
　　Dim myCell　　　As Range
　　Dim bolFlag　　 As Boolean
　　Dim intIDX　　　As Integer

Set TargetRange = ActiveSheet.Range(RangeString)

For Each myCell In TargetRange
　　　　bolFlag = False
　　　　If myCell.Font.ColorIndex = intColor Then bolFlag = True
　　　　If myCell.Interior.ColorIndex = intColor Then bolFlag = True
　　　　If myCell.Value <> "" Then
　　　　　　For intIDX = 1 To Len(myCell.Value)
　　　　　　　　If myCell.Characters(intIDX, 1).Font.ColorIndex = intColor Then bolFlag = True
　　　　　　Next
　　　　End If
　　　　
　　　　If bolFlag Then SpecialCell = SpecialCell + 1
　　Next
　　
End Function

動作確認してませんが(^^;
=SpecialCell("D10,D8,D29,D49,D51,D57",3)
のように、検査したいセルのアドレスをダブルクォーテーション「"」で囲んで下さい。

kmetu · Answer

もう一点は

Function SpecialCell(targetRange As Range, _
intColor As Integer) As Integer
'赤は3，緑は4，青は5，黄は6
Dim myCell As Range

For Each myCell In targetRange

For i = 1 To Len(myCell.Value)
     If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = intColor Then
        SpecialCell = SpecialCell + 1
        End If
    Next
Next
End Function

というコードでいかがでしょうか。

kmetu · Answer

> 今までのを消して上記を入れてみましたが、、、
>
> 今まで出来ていた1色のところも0になりました。
> 3色のところも０になりました。。。

うーん…こちらで適当なデータを入れて試したら指定色の文字数分の数値がでるのですが…
具体的にどのようなデータなのでしょうか。

全部は無理としても

D10,D8,D29,D49,D51,D57

のデータだけでも示せますでしょうか。

tom04 · Answer

こんばんは！
せっかくコードをお考えのようなので、余計なお世話になるかもしれませんが・・・

セルを範囲指定した後に実行するマクロを考えてみました。
（Sheet2を作業用のSheetとして使用していますので、Sheet2は使用していないという前提です）

Sheet1のマクロにしていますので、画面左下にあるSheet1のSheet見出し上で右クリック　→　コードの表示　→　↓のコードをコピー＆ペーストし、範囲指定した後にマクロを実行してみてください。

Sub test()
    Dim c As Range
    Dim i As Long
    Dim str As String
    Dim ws As Worksheet
    Set ws = Worksheets(2)
    Application.ScreenUpdating = False
    For Each c In Selection
    For i = 1 To Len(c)
    str = Mid(c, i, 1)
    If WorksheetFunction.CountIf(ws.Columns(1), c.Characters(Start:=i, Length:=1) _
        .Font.ColorIndex) = 0 And c.Characters(Start:=i, Length:=1).Font.ColorIndex <> xlAutomatic Then
            ws.Cells(Rows.Count, 1).End(xlUp).Offset(1) = _
                c.Characters(Start:=i, Length:=1).Font.ColorIndex
    End If
        Next i
        ws.Cells(Rows.Count, 2).End(xlUp).Offset(1) = WorksheetFunction.Count(ws.Columns(1))
        ws.Columns(1).Clear
        Next c
        ws.Cells(Rows.Count, 2).End(xlUp).Offset(1) = WorksheetFunction.Count(ws.Columns(1))
        ws.Columns(1).Clear
        MsgBox ("3色使用セルは" & WorksheetFunction.CountIf(ws.Columns(2), 3) & "個です。")
        ws.Columns(2).Clear
    Application.ScreenUpdating = True
End Sub

※　セル内のフォント色は「自動」以外の物を数えるようにしてみました。
※　上記コードは「3色」の場合のコードですので、2色の場合は
＞MsgBox ("3色使用セルは" & WorksheetFunction.CountIf(ws.Columns(2), 3) & "個です。")
の行を
＞MsgBox ("2色使用セルは" & WorksheetFunction.CountIf(ws.Columns(2), 2) & "個です。")

に変更してマクロを実行してみてください。

以上、参考になれば良いのですが・・・m(_ _)m

kmetu · Answer

> E欄の統計を取る際に、例えば同一セル内で
>
> (1)(2)(3)（左から、赤・黒・青）
> (1)(2)(3)（左から、黒・黒・赤）
> (1)(2)(3)（左から、青・赤・青）
>
> これの回答を
> 赤　3個
> 青　3個
> ピンク　0個
> 
> というような集計をしたくて、ご相談しました。。。

Function SpecialCell(targetRange As Range, _
intColor As Integer) As Integer
'赤は3，緑は4，青は5，黄は6
Dim myCell As Range
Dim myFlg As Boolean

Function SpecialCell(targetRange As Range, _
intColor As Integer) As Integer
'赤は3，緑は4，青は5，黄は6
Dim myCell As Range

For Each myCell In targetRange
    For i = 1 To Len(myCell.Value)
        If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = intColor _
        Or myCell.Interior.ColorIndex = intColor Then
            SpecialCell = SpecialCell + 1
        End If
    Next
Next
End Function

前回のコードに元にあったOr myCell.Interior.ColorIndex = intColorを足してます。
(足さなくてもE列に関しては同じですが)

で

=SpecialCell(E6:E126,3)/3
=SpecialCell(E6:E126,5)/3
 
これでこちらでは希望の数値が出ました。具体例が3文字なので1セット3文字と考えてます。

> ちなみに標準モジュールに下記コードを追加して両方走らせると、

両方走らせるというのがちょっと意味がわかりません。

kmetu · Answer

> 具体例が3文字なので1セット3文字と考えてます。

(1)を1セット3文字という意味です。

Cor_moriyan · Answer

=SpecialCell("D10,D8,D29,D49,D51,D57",3)
のように、検査したいセルのアドレスをダブルクォーテーション「"」で囲んで下さい。

↑
です。アドレスの指定している部分を「"」で囲んで「文字列」にしてください。
通常のセル範囲指定とは異なります。

Cor_moriyan · Answer

補足を読みました。
(1)(2)(3)で・・・という事なら、「)」「(」を無視して 123 だけ判定すれば良いですね(^^)
なので

Function SpecialCell(RangeString As String, intColor As Integer) As Integer
　　'赤は3，緑は4，青は5，黄は6
　　Dim TargetRange As Range
　　Dim myCell　　　As Range
　　Dim intIDX　　　As Integer
　　Dim strVALUE　　As String

Set TargetRange = ActiveSheet.Range(RangeString)

For Each myCell In TargetRange
　　　　If myCell.Font.ColorIndex = intColor Then
　　　　　　SpecialCell = SpecialCell + 1
　　　　　　GoTo SkipFor
　　　　End If
　　　　If myCell.Interior.ColorIndex = intColor Then
　　　　　　SpecialCell = SpecialCell + 1
　　　　　　GoTo SkipFor
　　　　End If
　　　　If myCell.Value <> "" Then
　　　　　　'"("と")"を取り除く
　　　　　　strVALUDE = Replace(Replace(myCell.Value,"(",""),")","")
　　　　　　For intIDX = 1 To Len(strVALUE)
　　　　　　　　If myCell.Characters(intIDX, 1).Font.ColorIndex = intColor Then
　　　　　　　　　　SpecialCell = SpecialCell + 1
　　　　　　　　End If
　　　　　　Next
　　　　End If
　　　　
SkipFor:
　　Next
　　
End Function

関数の書き方は　=SpecialCell("A1,D1,C1",3)　などと、セル範囲を【文字列】で渡す事に変わりはありません。

エクセルでの文字色を数える関数に関して。。。

コードは以下のようにして、

=SpecialCell((D10,D8,D29,D49,D51,D57),3)

このマクロは、ご自身で作成されたものですか？

この回答への補足

もう一点は

この回答への補足

> 今までのを消して上記を入れてみましたが、、、

この回答への補足

こんばんは！

> E欄の統計を取る際に、例えば同一セル内で

この回答への補足

> 具体例が3文字なので1セット3文字と考えてます。

この回答への補足

=SpecialCell("D10,D8,D29,D49,D51,D57",3)

補足を読みました。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング