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


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点ほどご教授いただけると助かります。
よろしくお願いいたします。。。

このQ&Aに関連する最新のQ&A

A 回答 (12件中1~10件)

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かと。

この回答への補足

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

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

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

補足日時:2011/12/01 16:08
    • good
    • 0
この回答へのお礼

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

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

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

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

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

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

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

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

お礼日時:2011/12/01 16:01

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


> E欄の統計を取るマクロを入れるとD欄が壊れる。

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

同じ名前(Function SpecialCell)で

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

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

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

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

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

でいけます。
    • good
    • 0
この回答へのお礼

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

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

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

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

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

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

お礼日時:2011/12/01 15:42

補足を読みました。


(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) などと、セル範囲を【文字列】で渡す事に変わりはありません。
    • good
    • 0

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


のように、検査したいセルのアドレスをダブルクォーテーション「"」で囲んで下さい。


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

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



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

この回答への補足

あ、ごめんなさい。

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

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

補足日時:2011/12/01 11:54
    • good
    • 0

> 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
という意味です。

補足日時:2011/12/01 11:54
    • good
    • 0

こんばんは!


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

セルを範囲指定した後に実行するマクロを考えてみました。
(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
    • good
    • 0
この回答へのお礼

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

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

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

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

お礼日時:2011/12/01 09:49

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


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

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

全部は無理としても

D10,D8,D29,D49,D51,D57

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

この回答への補足

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

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

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

補足日時:2011/12/01 09:43
    • good
    • 0
この回答へのお礼

>例えば同一セル内で

分かりにくいので訂正。

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

お礼日時:2011/12/01 09:46

もう一点は



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色のところ)

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

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

補足日時:2011/11/30 18:04
    • good
    • 0

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



> =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色ある部分は目視計算)


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

補足日時:2011/11/30 18:00
    • good
    • 0

このQ&Aに関連する人気のQ&A

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

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

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

このQ&Aと関連する良く見られている質問

QEXCELでセル参照の際に、参照元セルの色を参照先セルの色を反映させたい。

はじめて質問します。宜しくお願いします。
現在の手書き伝票をEXCELで再現・作成したいと考えております。
手書き伝票は、複写式で合計4枚になります。
経費削減のため、SHEET1の1枚入力欄に記入すると、
SHEET2に入力内容が反映され、印刷ではA3用紙1枚が出力され、
印刷したものをカッターで4分割して4枚として使用したいです。

現在は、会社名や住所、電話番号の変更があった際は、伝票横の余白に「⚪︎⚪︎変更あり」と
かいておりますが、文字が見にくくなったり、見落としたりする可能性があります。
EXCELでは変更のあったセルをわかりやすくしたいのです。
ただし、カラーは使用せず、白黒のみとしたいので、
「太字・斜体・変更したセルを薄いグレーの網かけにする」を考えています。

しかし、セルの参照では、参照元セルの文字だけが参照先セルに入力され、
参照元の書式が反映されなくて困っています。

そこで、皆様のお知恵をお借りしたいのですが、
EXCELのVBAはわかりませんので、できるだけ簡単なものでできると助かります。
VBAが必要でしたら、勉強しますので、できるだけわかりやすくお願いします。

最後に、上記のような伝票を作成する上での注意点などがありましたら、
あわせてアドバイス頂けますと大変嬉しいです。

何卒、宜しくお願いいたします。

はじめて質問します。宜しくお願いします。
現在の手書き伝票をEXCELで再現・作成したいと考えております。
手書き伝票は、複写式で合計4枚になります。
経費削減のため、SHEET1の1枚入力欄に記入すると、
SHEET2に入力内容が反映され、印刷ではA3用紙1枚が出力され、
印刷したものをカッターで4分割して4枚として使用したいです。

現在は、会社名や住所、電話番号の変更があった際は、伝票横の余白に「⚪︎⚪︎変更あり」と
かいておりますが、文字が見にくくなったり、見落としたりする可能性があり...続きを読む

Aベストアンサー

一案です。
一枚分の入力の作業が終わったら
一枚部分の範囲を選択、コピー
A3全体を選択
張り付け、形式を選択して貼り付け
書式にチェックを入れて OK

これで良ければマクロの記録で
VBA化してみてください。

Q条件を満たすセルの合計 セルが複数の場合

SUMIF関数で条件を満たす合計を出したいのですが、セルが横に複数の場合の関数がうまくできません。

○がついているセルの合計をNのセルに出したいのですが、
たとえば、【4月の八百屋】の合計だけなら【=SUMIF(B2:B4,"○",D2:D4)】でよいと思うのですが、
【スーパー】【コンビニ】【その他】も含む合計の場合はどうしたらいいのでしょうか?

単純に、【=SUMIF(B2:B4,"○",D2:D4)+SUMIF(E2:E4,"○",G2:G4)・・・】とやっていく方法しかないのでしょうか?

※EXCEL2013です。

Aベストアンサー

=SUMIF(B2:K4,"○",D2:M4)

では如何でしょうか?
で、この場合答えは285でいいのでしょうか?

QMS Office 2007,2010,2013で作成したPDFのバージョンを教えてください。

質問1、
MS Office 2007,2010,2013で作成したPDFのバージョンをそれぞれ教えてください。
また、バージョンを選択して変換することはできますか?

質問2、
変換の時に規格(x-1a~x-4等)を選ぶことは出来ますか?
出来るときはその手順(メニュー)も教えてください。

よろしくお願いします。

Aベストアンサー

MSDN(まいくろそふとでべろっぱーずねっとわーく)の文書をお読みください。
http://blogs.msdn.com/b/officeinteroperability/archive/2013/04/04/microsoft-support-for-pdf.aspx

Q=INDIRECT関数について

シート”一覧” から文字を持ってきています。
4行目まで1行毎タイトル等で
5行・6行をセルの結合して見出しつけてます。
7・8行からセルの結合して 連番1からつけています。

=INDIRECT("一覧!C" & 5 +A5*2)

先任者が作っていた上の式の内容がよくわかりません。教えてください。
この式のところには 7・8行結合のC欄の内容が表示されます。

& 5 +A5*2 の 解説よろしくお願いします。

※OKWaveより補足:「富士通FMV」についての質問です。

Aベストアンサー

No.1です。
たびたびごめんなさい。

一番大事なコトを書き忘れました。
>& 5 +A5*2 の 解説よろしくお願いします。

は前回回答した通りですが、なぜ2倍か?
となれば質問文にあるように、2行ずつセルが結合されているというコトですので、
結合セルのセル番地は最初のセル番地となります。
そのために2倍しているものと思われます。

>5行・6行をセルの結合して見出しつけてます。
というコトですので
必ず7行目以降の奇数行を返すための式ですね。
(偶数行を指定すると「0」が返ると思います。)m(_ _)m

QACCESS2013  空白セルにデータをコピーす

お世話になっております。

添付画像にあるクエリを作成しました。
黄塗りのセル(「商品コード」フィールドの1と「10」フィールドの交差する場所)が空白になっています。
この空白部に「10」フィールドの一つ前のフィールドの値をコピーしたいのですが関数式を教えてください(ここでは、「9」フィールドの16,500をコピーしたい)。

1.添付の上段の画像の場合は、以下の関数でいいのでしょうか?
  iff([10]=" ", [9].[10])

2.添付画像下段にあるような[10]フィールドの前のフィールド名が固定できない
 場合は([9]フィールドではなく、[7]や他の名称に変わる場合)の関数式を教えてください。

よろしくお願いします。

Aベストアンサー

これの元はクロス集計でしょうか。

クロス集計の結果をテーブルに書き出して、
その出来上がったテーブルを書き換えた方が楽だと思います

以下の様な雰囲気で

Public Sub Samp1()
  Dim rs As New ADODB.Recordset
  Dim i As Long
  Dim bChg As Boolean
'
' ここで、クロス集計をテーブルとして作成し、
' 出来上がったテーブルを対象に・・・
'

  rs.Open "テーブル名", CurrentProject.Connection _
            , adOpenForwardOnly, adLockOptimistic
  i = rs.Fields.Count - 1
  While (Not rs.EOF)
    If (IsNull(rs(i))) Then
      rs(i) = rs(i - 1)
      rs.Update
    End If
    rs.MoveNext
  Wend
  rs.Close

とか

  rs.Open "テーブル名", CurrentProject.Connection _
            , adOpenForwardOnly, adLockOptimistic
  While (Not rs.EOF)
    bChg = False
    For i = 4 To rs.Fields.Count - 1
      If (IsNull(rs(i))) Then
        rs(i) = rs(i - 1)
        bChg = True
      End If
    Next
    If (bChg) Then rs.Update
    rs.MoveNext
  Wend
  rs.Close
End Sub


※ 空白部分は、他の表示を見る限り Null と思われるので、
1度、上記( IsNull 判別 )でやってみてください。

これの元はクロス集計でしょうか。

クロス集計の結果をテーブルに書き出して、
その出来上がったテーブルを書き換えた方が楽だと思います

以下の様な雰囲気で

Public Sub Samp1()
  Dim rs As New ADODB.Recordset
  Dim i As Long
  Dim bChg As Boolean
'
' ここで、クロス集計をテーブルとして作成し、
' 出来上がったテーブルを対象に・・・
'

  rs.Open "テーブル名", CurrentProject.Connection _
            , adOpenForwardOnly, adLockOptimistic
  i = rs.Fields.Count - 1
...続きを読む


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

おすすめ情報