質問

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


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)
これでは0と出てきてしまいます。。。
この場合はどういう風に数式をいれればよいのでしょうか?


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

通報する

回答 (12件中1~10件)

> 現在入れているマクロでD欄は正常に統計が取れます。
> E欄の統計を取るマクロを入れるとD欄が壊れる。

入れるとはどういう意味でしょうか?

同じ名前(Function SpecialCell)で

> なので、標準モジュール1を最初の奴
> 標準モジュール2を教えていただいた奴

としたのでしょうか。でしたらそれは無茶でしょうし"名前が適切ではありません。"
とエラーが出るのは当然です。

とりあえず名前を変えて試すか、私の示したコードだけで試してください。

丸付きの文字3文字でしたら

/3は不要で
=SpecialCell(E6:E126,3)
=SpecialCell(E6:E126,5)

でいけます。

この回答へのお礼

>エラーが出るのは当然です。

すいません、基本素人なもので、とりあえず試してみただけですw

そして、やはりANo.7のコードに変えて、それまで計算していたD欄の統計部分の計算式を再計算するとコンパイルエラーがでます。。。

=SpecialCell(E6:E126,3)
でE欄のところに埋め込んでもやはり計算してくれませんでした。。。

ANo.11さんのコードを入れてみたところ1回答えが全ておかしくなりましたが、エラーではなかったため、再計算すると元に戻り、D欄&E欄も無事に計算できました。
こちらのコードでもう少々ごにょごにょしてみたいと思います。

長い間ご教授いただきありがとうございました。。。
また、よろしくお願いいたします。。。

kmetu さんの「セル範囲を()で囲む」を私のソースに適用させてもらって(^^;
ん? (1) は【丸囲み数字1】ですか?では

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

  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
      For intIDX = 1 To Len(myCell.Value)
        If myCell.Characters(intIDX, 1).Font.ColorIndex = intColor Then
          SpecialCell = SpecialCell + 1
        End If
      Next
    End If
  
SkipFor:
  Next
 
End Function

これで、=SpecialCell((D10,D8,D29,D49,D51,D57),3) のように書けばOKかと。

この回答へのお礼

たびたびありがとうございます。

このコードを試したところ、無事D欄・E欄ともに計算してくれました。

そして恐縮ながらもう一つ教えていただけると助かります。。。

Dの縦欄は、セル内背景色を分けているのと、文字色は1色です。
(なので、背景色ごとのセル分けで集計するための問1でした)

このセル内の背景色を4色で分けているのですが、中の文字色は関係なく、背景色の数字を数えるのはできますでしょうか?

%を出す為に、現在背景色を手計算で問1で教えていただいた数字で割っております。。。
この背景色も計算できると非常に助かります。。。
(現在のD欄とE欄の計算式が壊れないよう)

http://miyahorinn.fc2web.com/tips/s_02_02_04_02. …
とりあえず、これを元に作成してみますけど、問題があればご教授下さいませ。
よろしくお願いたします。。。

そしてありがとうございました。。。
助かりました。。。

この回答への補足

ごめんなさい。下記のURLでいけました。

今までの経緯を思うと、壊れるの前提で書いてしまいましたw

ありがとうございました。。。

補足を読みました。
(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)
のように、検査したいセルのアドレスをダブルクォーテーション「"」で囲んで下さい。


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

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

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

この回答への補足

あ、ごめんなさい。

括弧で出てきちゃうのですが、実際には丸がこみの数字で
(1)(2)(3)←これでワンセット3文字です。

ややこしくてすいません。

> 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文字と考えてます。

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

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

この回答への補足

早々の解答ありがとうございます。


早速いれてみたところ、、、
コンパイルエラー 名前が適切ではありません。
っと出ましてD欄の統計部分もダメになりました。
(#NAME)
いけそうな気がしたのですが、、、


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

現在入れているマクロでD欄は正常に統計が取れます。
E欄の統計を取るマクロを入れるとD欄が壊れる。

なので、標準モジュール1を最初の奴
標準モジュール2を教えていただいた奴

とやればうまくいけるかな?
っと思ったので試してみたらダメでしたw
という意味です。

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

セルを範囲指定した後に実行するマクロを考えてみました。
(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

この回答へのお礼

ご教授ありがとうございます。

やってみました!
これはこれで面白いですね!

なのですが、すいません。
その出てきた数字をさらに集計しまとめなければいけないので、データとして張り付いていないとだめなのです。。。

でも、ありがとうございました。。。

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

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

全部は無理としても

D10,D8,D29,D49,D51,D57

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

この回答へのお礼

>例えば同一セル内で

分かりにくいので訂正。

セルが3個あって、1個のセル内に3つの数字があり、その3つの数字に色がついています。

この回答への補足

再度ありがとうございます。

Dの縦欄は、セル内背景色を分けているのと、文字色は1色です。
(なので、背景色ごとのセル分けで集計するための問1でした)

Eの縦欄は背景色は無くて全てのセルに(1)(2)(3)数字が3個あり、その内1位なら赤、2位なら青、3位ならピンク、それ以外は黒と入力と文字色分けは手入力です。

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

(1)(2)(3)(左から、赤・黒・青)
(1)(2)(3)(左から、黒・黒・赤)
(1)(2)(3)(左から、青・赤・青)

これの回答を
赤 3個
青 3個
ピンク 0個

というような集計をしたくて、ご相談しました。。。
最初からセルを分けてれば問題は無かったのでしょうが、そこまで気が回りませんでした。。。
セル分けをするとなると、もう膨大な量のデータになりそうなので、、、
現在手入力で数えてますが、その内間違えそうですw

ちなみに標準モジュールに下記コードを追加して両方走らせると、数値が正しく無いと出て表示自体が全部壊れてしまいました。。。

もう一点は

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

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

この回答への補足

ご教授ありがとうございます。

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

今まで出来ていた1色のところも0になりました。
3色のところも0になりました。。。


=SpecialCell(D5:D125,3)(1色のところ)
=SpecialCell(E5:E125,3)(3色のところ)

呼び出す引数の書き方がおかしいのでしょうか?

またご教授下さい。よろしくお願いいたします。

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

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

Functionで定義している引数が2つ(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)
のように、検査したいセルのアドレスをダブルクォーテーション「"」で囲んで下さい。

この回答への補足

回答ありがとうございます。

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

いえ、ほとんど素人ですので、ググッてググッてようやく見つけたマクロをいれてます。。。

第(1)の問いはNO2さんの括弧で囲む方法でいけました。

第(2)に関しては、教えていただいたマクロを今まで書いてあったのを消して再計算してみましたら、、、
今まで、=SpecialCell(D5:D125,3)
で出てきたところも0となってしまいできませんでした。。。

現状、セル内に1色の文字がある項目の計算は
=SpecialCell(D5:D125,3)
で出来てます。

セル内に1色~3色の文字がある項目の計算ができません。

(両方計算する必要があり、現在3色ある部分は目視計算)


またご教授いただければ幸いです。

このQ&Aは役に立ちましたか?1 件

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

新しく質問する

注目の記事

ウイルスソフト何を使ってますか?

無料ウイルスソフトインストール後のトラブル問題から、ウイルスソフトの効果について有料のものと比較しながらまとめました。

このQ&Aを見た人が検索しているワード


新しく質問する

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

毎日見よう!教えて!gooトゥディ

べんりQ&A特集