『指定色文字以外の合計』（HH） ・・・・・・N・・・・ ・・・・・・38・・・・N１〜N３７までに含まれる赤文字の個数COUNTA（合計ではありません） Nの５３７には通常の黒数字の合計数　（今度は個数ではありません） Nの５３８には赤文字の（個数COUNTA） を出したいのですが？ 初心者ですのでよろしくお願いいたします。 ---- ↓は参考になりませんか？ http://www.excel.studio-kazu.jp/cgi-bin/kazuwiki2.cgi?mycmd=read&mypage=[[20060309180850]] (MARBIN) ---- 衝突〜☆ 　 折角なのでUP 作業列で O列 を使用します。 　 １）O1 にカーソルを置く ２）挿入 → 名前 → 定義 ３）名前　：　iro　（自分でわかるものなら何でもOK） 　　参照範囲　：　=GET.CELL(24,N1)+NOW()*0 　　OK ４）O1 =iro 　　以下コピー（O37まで） ５）N537 =SUMIF(O1:O37,0,N1:N37) ６）N538 =COUNTIF(O1:O37,3) ※色を変更したときは、「F9」で再計算させてください。 （キリキ）（〃⌒o⌒)b ---- 下記のコメントは、HHさんでしょうか？ [[20060309180850]]『セル色をカウントする方法』（よよ） 　 マクロがご希望なのでしょうか？ （キリキ）（〃⌒o⌒)b ---- なんか間違ってリンク先にレスしているような・・・。 と書いているうちにキリキさんからレスが・・・。 (MARBIN) ---- マクロが希望です。わがままですみません。 ---- こんな感じで如何でしょう？ 　 Sub test() Dim Rng As Range Dim Rcnt As Long, Rsum As Long For Each Rng In Range("N1:N37") Select Case Rng.Font.ColorIndex Case -4105 Rsum = Rsum + Rng Case 3 Rcnt = Rcnt + 1 End Select Next Rng Range("N537") = Rsum Range("N538") = Rcnt End Sub 　 ※レイアウトや条件が変わった場合はご自身で変更できるのでしょうか？ 　 （キリキ）（〃⌒o⌒)b ありがとうございました。説明不足ですみません。 指定の列ですが出したい所が数箇所あります。すみません それと式は何といれたらよいのでしょうか？？ 赤文字の個数COUNTAの出すとこの式？（コピーでOKですか？） 黒数字の合計数の出すとこの式？（コピーでOKですか？） 何度も申し訳ございません。 ---- >指定の列ですが出したい所が数箇所あります。 まぁ、そんな感じだとは思っていましたけど。。。 上記マクロを変更できるスキルはございますか？ もし、変更できないのであればマクロの使用は控えたほうが良いような気がします。 とは、言いいつつ 範囲を指定してから実行するものを考えてみました。 　 Sub test2() Dim Rng As Range Dim Rcnt As Long, Rsum As Long, MyR As Long MyR = Selection.Column For Each Rng In Selection Select Case Rng.Font.ColorIndex Case -4105 Rsum = Rsum + Rng Case 3 Rcnt = Rcnt + 1 End Select Next Rng Cells(537, MyR) = Rsum Cells(538, MyR) = Rcnt End Sub 　 ※これから出かけますので、レスができません。 （キリキ）（〃⌒o⌒)b ---- 携帯から、、、 上記変数は、へんでしたね。。。 MyR より MyC の方がよかったな… 急いでやると、失敗だらけだな〜 反省＼(__) (キリキ)（〃⌒o⌒) 出したい所にどういう関数を入れて出せばよろしくお願いいたします。 マクロは入れました。。。 ---- ユーザー定義関数のマクロではありませんので、関数を入れたりはしません。。。 １、範囲を指定(今回の場合、N1〜N37) ２、F8 を押し、test2 を実行 以上で、指定した列の537 に、黒数字の合計・538 に、赤字の数がでます。 これで、あんさんのご希望のものになりませんでっしゃろか？ マクロにも、色々あるっちゅー事ですわ、はい。(笑 (キリキ)（〃⌒o⌒)b やはり初心者では無理でした。残念勉強します。 以前のを調べた所このマクロは赤の合計を出すのですが 黒だけを合計するのに何処を直せばよろしいでしょうか？？ Function FCS(adrs, clr) sm = 0 For Each ad In adrs fci = ad.Font.ColorIndex cv = ad.Value If fci = clr Then sm = sm + cv End If Next FCS = sm End Function 関数＝ＦＣＳを使用します。 できればこの式を合計ではなくて（個数COUNTA）にしたいのです。 黒の合計＆赤のCOUNTAをよろしくお願いいたします。 ---- どうも、携帯からだと間違ってばかりだな… ２、訂正！ Alt+F8 で、test2 を実行です。 (キリキ)（〃⌒o⌒)b 実行してもできませんでした。 上記のものではむりでしょうか？何度もすみません。。 ---- バージョンが2000以降なら Function FCS(rng As Range, clr As Integer) As Double Dim r As Range Application.FindFormat.Font.ColorIndex = clr Set r = rng.Find("*", searchformat:=True) If Not r Is Nothing Then ff = r.Address Do mysum = Application.Sum(mysum, r) Set r = rng.Find("*", r, searchformat:=True) Loop Until r.Address = ff FCS = mysum End If End Function ---- ほんなら、これ =red(範囲) と書きます。 念のために申し上げときますけど文中範囲とあるのはN1:N37と書かなあきまへんでぇ。 黒の合計は =blacktotal(範囲) 　　　　　　　（弥太郎） Application.Volatileが記入漏れでしたんで追加18:23 '----------------- Function Red(adrs) Dim c Application.Volatile For Each c In adrs If c.Font.ColorIndex = 3 Then Red = Red + 1 End If Next c End Function '----------------------- Function blacktotal(adrs) Dim c Application.Volatile For Each c In adrs If Not c.Font.ColorIndex > 0 Then totl = totl + c.Value End If Next c blacktotal = totl End Function ---- しょうとつ〜☆ 　 σ(^o^;)も、考えてみました＾＾ 　 =colsum(範囲,色番号) 指定範囲の指定色の合計を出します。 '------------------ Function colsum(adrs As Range, col As Integer) As Variant Dim Rng As Range Dim sm As Long, Rcol Application.Volatile For Each Rng In adrs Rcol = Application.WorksheetFunction.Max(Rng.Font.ColorIndex, 0) If Rcol = col Then sm = sm + Rng End If Next Rng colsum = sm End Function =colcnt(範囲,色番号) 指定範囲の指定色の数を出します。 '------------------ Function colcnt(adrs As Range, col As Integer) As Variant Dim Rng As Range Dim cnt As Long Application.Volatile For Each Rng In adrs If Rng.Font.ColorIndex = col Then cnt = cnt + 1 End If Next Rng colcnt = cnt End Function 　 （キリキ）（〃⌒o⌒)b 皆さんありがとうございます。（弥太郎）さんの方で行ってみましたが？ 赤数字が合計になったり全部消しても数字がゼロにならないのですが？？ やり方が悪いのでしょうか？ （キリキ）さんの方も今挑戦していますが？？？ ---- >（キリキ）さんの方も今挑戦していますが？？？ 挑戦してるけど、だめでしょうか？ まだ起きてますから、何かあったらカキコしてください＾＾ （キリキ）（〃⌒o⌒)b ---- HHさん、厄介な事に色の計算っちゅうんは即座に反応してくれまへんのんですワ、えぇ 従ってF9を押下して再計算させなければなりまへん。 それが面倒やったらそのSheetモジュールに '----------------- Private Sub Worksheet_SelectionChange(ByVal Target As Range) Calculate End Sub を入れとくと即座ではありまへんが他のセルを選択した時点で再計算されますワ。 せやけど、これ使うとコピー貼り付けが思うようにでけんようになりまっせ。 面倒でもF9で再計算させた方がええと思いますワ。 　　　　　（弥太郎） ありがとうございました。黒文字だけの合計は出来ましたが 赤指定のCOUNTAのほうが最初から赤色を指定しておくと数字を入れなくても ＣＯＵＮＴＡしてしまいます？指定しておいて、数字を入れた所だけをＣＯＵＮＴＡ したいのですが？？何度も申し訳ございません。。 '----------------- Function Red(adrs) Dim c Application.Volatile For Each c In adrs If c.Font.ColorIndex = 3 Then Red = Red + 1 End If Next c End Function '----------------------- Function blacktotal(adrs) Dim c Application.Volatile For Each c In adrs If Not c.Font.ColorIndex > 0 Then totl = totl + c.Value End If Next c blacktotal = totl End Function この式を使用しています。 ---- はい、はい、わかります。 ほんならこれに差し替えておくんなはれ。 　　　　（弥太郎） Function Red(adrs) Dim c Application.Volatile For Each c In adrs If c <> "" Then If c.Font.ColorIndex = 3 Then Red = Red + 1 End If End If Next c End Function 何度もありがとうございました。完璧です。！！！！（⌒o⌒) 後でまたその他の事で質問など宜しくお願い致します。。 色々ありがとうございました。問題が出てきてしまいました。 Ｎ列で　途中に＝ＳＵＭが入っている箇所があるのですが（数箇所） それまで合計してしまいます。範囲を指定してblacktotal(adrs)を使用すると 指定が多いのか？？エラー表示になってしまいます。。 計算式（関数）の入っていない部分だけ合計する事ってできるのでしょうか？？ ---- >計算式（関数）の入っていない部分だけ やったら 　　　If Not c.Font.ColorIndex > 0 And Not c.HasFormula Then に書き換えてみてくらはい。 　　　　　　　（弥太郎） 下のように書き換えて見ましたが？？#VALUEがでてしまいました？？ '----------------- Function Red(adrs) Dim c Application.Volatile For Each c In adrs If c <> "" Then If c.Font.ColorIndex = 3 Then Red = Red + 1 End If End If Next c End Function '----------------------- Function blacktotal(adrs) Dim c Application.Volatile For Each c In adrs If Not c.Font.ColorIndex > 0 And Not c.HasFormula Then totl = totl + c.Value End If Next c blacktotal = totl End Function どこがいけないのでしょうか？教えて下さい。。 blacktotal(adrs)で範囲指定しましたが・・・・? すみません、、この列には数字以外の文字も含まれています・・ 関数以外＆文字以外でお願いできないでしょうか？？ ---- え〜　ししようの代わりにお答えしますが、、、 条件等を小出しにするのは如何なものかと思いますよ〜♪ 下記に変更してみてください＾＾ If IsNumeric(c) And Not c.Font.ColorIndex > 0 And Not c.HasFormula Then がんばって、ヘルプと睨めっこしてご自身で修正できるようになれば良いですね＾＾ （キリキ）（〃⌒o⌒)b ありがとうございました。条件等を小出しにしてすみません。。 行っているうちにいろいろ出てきてしまって・・ また、小出しと言われてしまいますが、最後に１つだけよろしいでしょうか？ Redの部分も、赤色の数字のＣＯＵＮＴＡ（関数以外＆文字以外）で変更できますでしょうか？？ 最後のお願いですのでよろしくお願い致します。 ---- blacktotal(adrs) の時に、どんなことをしましたか？ まず、ご自身でやってみましょう〜 　 同じことをすればいいだけだと思いますよ？ 各命令をヘルプで見ると何をしているかがわかると思います＾＾ ※VBAのヘルプは、インストールしないと見れません。 （キリキ）（〃⌒o⌒)b やはりわかりませんでした。。 If IsNumeric(c) And Not c.Font.ColorIndex > 3 And Not c.HasFormula Then でやってみましたが？？ ---- このように、ためした結果を書いていただくと、具体的にレスがつけやすいっすね〜♪ まず、red のコードの、colorindex は、3 でしたね？ 符号は、= ではなかったですか？ 考え方は、blacktotal と同じです。 条件を増やしていくだけですよ〜♪ (キリキ)（〃⌒o⌒)b If IsNumeric(c) And Not c.Font.ColorIndex = 3 And Not c.HasFormula Then 変えてみましたがだめです。。。教えていただけませんか？？お願いです・・ 明日使用したいのですが・・ ---- >If IsNumeric(c) And Not c.Font.ColorIndex = 3 And Not c.HasFormula Then >変えてみましたがだめです。。。教えていただけませんか？？お願いです・・ では、ししょ〜のコードを初めから見てみましょう〜♪ 1、 　　　　If c.Font.ColorIndex = 3 Then 　　　　　　Red = Red + 1 2、空欄を除外するために、、、 　　If c <> "" Then　　　←ココが追加になりました。 　　　　If c.Font.ColorIndex = 3 Then 　　　　　　Red = Red + 1 3、blacktotalで「関数の入っていないもの」を条件に追加した場合 　　　　If Not c.Font.ColorIndex > 0 Then が、、、 　　　　If Not c.Font.ColorIndex > 0 And Not c.HasFormula Then ~~~~~~~~~~~~~~~~~~~~~~~~~~ と、追加されました。 4、「文字以外」の条件追加で 　　　　If IsNumeric(c) And Not c.Font.ColorIndex > 0 And Not c.HasFormula Then ~~~~~~~~~~~~~~~~~ と、追加されました。 5、今回は、3番の追加と4番の追加を「red」にもするのですから、 　　If c.Font.ColorIndex = 3 Then 　　If c.Font.ColorIndex = 3 And Not c.HasFormula Then ~~~~~~~~~~~~~~~~~~~~~~~~~~ を、追加し。さらに、 　　If IsNumeric(c) And c.Font.ColorIndex = 3 And Not c.HasFormula Then ~~~~~~~~~~~~~~~~~ で出来ませんか？ ※HHさんのは、Notが余分なだけです＾＾ 　 Function Red(adrs) Dim c Application.Volatile For Each c In adrs If c <> "" Then If IsNumeric(c) And c.Font.ColorIndex = 3 And Not c.HasFormula Then Red = Red + 1 End If End If Next c End Function 　 衝突したと思ったら、、、 >明日使用したいのですが・・ ですか。。。 ご自身で調べたことは無駄にはならなかったでしょ？ 何かしらつかめたものはありませんでしたか？？ ヘルプはご覧になりました？？？ ここは、学校ですよ？ 答えを得るためだけの場とは違います。 それを知っていただきたくて、誘導していったつもりだったんですけど・・・ 何かしら得るものがあったら幸いです。。。 （キリキ）(〃⌒o⌒)b ---- どうもありがとうございました。勉強になりました。 今後、考慮してから質問いたしますので・・本当に助かりました＞＞ 前回はお世話になりました。もうひとつ質問してもよろしいでしょうか？？ 条件書式で下記のような指定で行を赤く出来たのですがＣＯＵＮＴＡが認識しないのですが？（赤くなった部分をフォント色でさし直しF9で認識します。） =OR(指定="○",指定="○") 最初からred のコードの、colorindex 3で出来ないのでしょうか？？何度も申し訳ございません。。 ---- 残念ながら、条件付書式での色付けを数えることは出来ません。。。 別案で、通常の関数で''「条件付書式で設定した条件を数える」''事は出来ます。 　 上記条件でしたら、数えたい場所に =SUMPRODUCT((範囲=条件)+(範囲=条件)) とすることで、条件付書式で色が変わった場所の数を数えることが出来ます。 （キリキ）(〃⌒o⌒)b ---- ありがとうございました。条件付書式での色付けを数えるではなくて 条件付書式での色付けをしたいのですが？書式で赤に指定しても赤にはなるのですが この間教えていただいたマクロでのIf IsNumeric(c) And c.Font.ColorIndex = 3 And Not c.HasFormula Then で反応しません。。任意で赤指定するとＣＯＵＮＴＡが認識します。 （式（マクロ）を変えたいのではありません） ---- ですから、、、 ''>残念ながら、条件付書式での色付けを数えることは出来ません。。。'' 　 通常に色付けしたもの以外（条件付書式での色付け）は、マクロやず〜と上のほうでσ(^o^;)が書いた GET.CELL関数などでは''認識しません''。 　 >この間教えていただいたマクロでのIf IsNumeric(c) And c.Font.ColorIndex = 3 And Not c.HasFormula Then >で反応しません。。 反応しないことが正解です。 反応させることは出来ないのです。 　 だから別案を記入しました。。。 　 ユーザー定義関数「red」と「SUMPRODUCT」をあわせて使用してみるのはいかがでしょう？ =red(範囲)+SUMPRODUCT((範囲=条件)+(範囲=条件)) （キリキ）（〃⌒o⌒)b ---- 条件の所がなにをいれていいのか？わからないのですが？？ 初心者で申し訳ございません。 ---- >初心者で申し訳ございません。 初心者を盾にするのはいかがなものかと。。。 >条件書式で下記のような指定で行を赤く出来たのですがＣＯＵＮＴＡが認識しないのですが？（赤くなった部分をフォント色でさし直しF9で認識します。） >=OR(指定="○",指定="○") ご自身でこのように仰っていましたよね？？ その条件を入れてあげればいいのです。 ・範囲、A1〜B10 までの背景色「赤」の数を出したい。 　※背景色変更と条件付書式での２パターンある場合。 ・条件付書式では、「=OR(A1="あ",A1="い")」と入力されているものとして ・数を出したいセルが C1 だとすると 　 C1 =red(A1:B10)+SUMPRODUCT((A1:B10="あ")+(A1:B10="い")) 　 （キリキ）(〃⌒o⌒)b ---- アーアー、聞こえますかキリキしぇんしぇぇ（笑 どなたの尻ぬぐいかしりまへんけど、ご苦労はんです。 えっと、これはこのスレに関係ありまへんのんやろけど、色の問題で色々ご苦労なさ ってらっしゃる御方が思いの外多いみたいなんで基本的な色関数（イロですよ（笑 を遊びがてら作ってみましたワ。 いや、以前に作っとったんを改造しただけの話ですから「作りましたと」言う表現は 正しゅうないかもしれまへんなぁ（笑 まぁ不行き届きな点はせんせぇに手ぇを加えて貰うて、より完全な関数に仕上げてもら うとして、とりあえずその関数を披露します、はい。 使い方は引数を３つ持った色作業関数で概ね事足りるように細工しときました。 作業を大きく分けると 1)色の付いたセルのカウント 2)色の付いたセルの数値の合計 3)文字色のカウント（HHさんの例） 4)色づけされた文字の（数値の）合計 こうなりますわなぁ。 それから条件によって細分化される事はあっても基本的にはこれで充分やと思います ねんけど、どうでっしゃろ？ 　 第１引数には範囲を指定します。これは説明不要と思われますので省略しときまっせ。 第２引数には↑の作業内容を"で囲んだ命令が必要です。 1)のキーワードはセルとカウント 2)のキーワードはセルと計 3)のキーワードは文字とカウント 4)のキーワードは文字、数値と計 になっとります。 ですから欲しいデータにご自分の分かりやすい表現で作業内容を指定すればええんと ちゃいまっか。 例えば"色の付いたセルのカウント" とか"色つき文字の合計" とか・・・ 第３引数には、色を指定します。これは省略可能で、省略すれば全ての色が指定色 になります。 １例を挙げると、=色作業(A1:D30,"色つきセルの合計","黄")と書くと 黄色のセルの数値を合計してくれますし、"黄"を省略すると色の付いたセルの合計を を算出してくれます、多分（笑 この黄は黄色でもイエローでも、およそエクセル初心者が陥りそうな入力ミス？でも カバーするよう配慮しとります。その点は律儀なエクセル君と違うておおようなもん ですワ、ハハハ。 ところで、この色の名前ですけど、エクセルのカラーパレットに準じてますから、あく までその名前を重視してくらはい。 どう見ても緑やとご自分で思いこんどっても、いざパレットの名前を見てみると明るい 緑とチップテキストに出とるばやいもありますしなぁ。 あたしゃぁ、若緑の表現がピッタシやと思うてそれも名前の一部に放りこんであります けど・・・。 あ、それから下のコードを全てコピペしたら関数一覧の最下行に色作業とでてきます んで、そこにも簡単に取り扱いを説明しとりますし、それ利用したら入力し易くなり まっせぇ。 呑んでるのになんでこんなにすらすら書けるんんやろ？？ 　　　　　　うぃー、ヒック（弥太郎） ---- あ、イケンイケン肝心のコード忘れとった（笑 '※ここから '------------------------------ Option Explicit Sub auto_open() Application.MacroOptions _ macro:="色作業", _ Description:="色付セル、色つき文字の計算及びカウントを引き受けまっせ。" _ & Chr(10) & "Adrs=範囲 Work=作業内容 例 セル色のカウント Colr=色の指定 省略すると全色指定になる" End Sub '------------------------------------------ Function 色作業(adrs As Range, work As String, Optional colr As Variant = 0) Dim colr_idx As Integer, work_case As Integer, get_type As Integer Dim totl As Double Dim c Application.Volatile colr = IIf(colr Like "*灰*", StrConv(colr, vbNarrow), colr) work_case = work_type(work) If colr <> 0 Then colr_idx = idx(colr) If colr_idx = 100 Or work_case = 5 Then 色作業 = "BuBuuu！(^ ^;" Exit Function End If If colr_idx = 1 Then Select Case work_case Case 1 For Each c In adrs If IsNumeric(c) And c.Interior.ColorIndex = 1 Then totl = totl + c.Value End If Next c Case 2 For Each c In adrs If IsNumeric(c) And c.Font.ColorIndex = 1 Or _ c.Font.ColorIndex = xlAutomatic Then totl = totl + c.Value End If Next c Case 3 For Each c In adrs If c.Interior.ColorIndex = 1 Then totl = totl + 1 End If Next c Case 4 For Each c In adrs If c <> "" And c.Font.ColorIndex = 1 Or _ c.Font.ColorIndex = xlAutomatic Then totl = totl + 1 End If Next c End Select Else If work_case < 3 Then For Each c In adrs get_type = IIf(work_case = 1, _ c.Interior.ColorIndex, c.Font.ColorIndex) If IsNumeric(c) And get_type = colr_idx Then totl = totl + c.Value End If Next c Else For Each c In adrs If work_case = 3 Then If c.Interior.ColorIndex = colr_idx Then totl = totl + 1 End If ElseIf work_case = 4 Then If c <> "" And c.Font.ColorIndex = colr_idx Then totl = totl + 1 End If End If Next c End If End If Else For Each c In adrs get_type = IIf(work_case = 1 Or work_case = 3, _ c.Interior.ColorIndex, c.Font.ColorIndex) Select Case work_case Case 1, 2 If IsNumeric(c) And get_type > 1 Then totl = totl + c.Value End If Case 3 If get_type > 0 Then totl = totl + 1 End If Case 4 If c <> "" And get_type > 0 Then totl = totl + 1 End If End Select Next c End If 色作業 = totl End Function '---------------------------------- Private Function work_type(ByVal work As String) As Integer If work Like "*セル*" And (work Like "*計*" Or work Like "*トータル*") Then work_type = 1 ElseIf (work Like "*文字*" Or work Like "*数値*") And (work Like "*計*" _ Or work Like "*トータル*") Then work_type = 2 ElseIf work Like "*セル*" And work Like "*カウント*" Then work_type = 3 ElseIf (work Like "*文字*" Or work Like "*数値*") And work Like "*カウント*" Then work_type = 4 Else work_type = 5 End If End Function '----------------------------------------- Private Function idx(ByVal colr As Variant) As Integer Select Case colr Case "黒", "黒色", "自動", "自動色", "xlAutomatic", "Auto", 1 idx = 1 Case "白", "白色", "ホワイト", 2 idx = 2 Case "赤", "赤色", "レッド", 3 idx = 3 Case "明るい緑", "明るい緑色", "薄緑", "薄緑色", "淡緑色", "若緑", 4 idx = 4 Case "青", "青色", "ブルー", 5 idx = 5 Case "黄", "黄色", "イエロー", 6 idx = 6 Case "ピンク", "ピンク色", "マゼンダ", "マゼンダ色", "桃色", 7 idx = 7 Case "水色", "シアン", "シアン色", 8 idx = 8 Case "濃い赤", "濃い赤色", "濃赤色", 9 idx = 9 Case "緑", "緑色", "グリーン", 10 idx = 10 Case "濃い青緑", "濃い青緑色", "濃青緑色", "濃青緑", 11 idx = 11 Case "濃い黄", "濃い黄色", "濃黄色", "黄土", "黄土色", 12 idx = 12 Case "紫", "紫色", "バイオレット", 13 idx = 13 Case "青緑", "青緑色", 14 idx = 14 Case "25%灰", "25%灰色", "25灰", "25灰色", 15 idx = 15 Case "50%灰", "50%灰色", "50灰", "50灰色", 16 idx = 16 Case "スカイブルー", "空色", 33 idx = 33 Case "薄い水色", "薄水色", "淡水色", 34 idx = 34 Case "薄い緑", "薄い緑色", "薄緑", "薄緑色", 35 idx = 35 Case "薄い黄色", "薄黄色", "淡黄色", "淡黄", 36 idx = 36 Case "ペールブルー", "ペースブルー色", 37 idx = 37 Case "ローズ", "ローズ色", "バラ色", 38 idx = 38 Case "ラベンダー", "ラベンダー色", 39 idx = 39 Case "ベージュ", "ベージュ色", 40 idx = 40 Case "薄い青", "薄い青色", "薄青色", "淡青色", 41 idx = 41 Case "アクア", "アクア色", 42 idx = 42 Case "ライム", "ライム色", 43 idx = 43 Case "ゴールド", "ゴールド色", "黄金色", "黄金", 44 idx = 44 Case "薄いオレンジ", "薄いオレンジ色", "淡オレンジ色", 45 idx = 45 Case "オレンジ", "オレンジ色", "橙色", 46 idx = 46 Case "ブルーグレー", "ブルーグレー色", "青灰色", 47 idx = 47 Case "40%灰", "40%灰色", "40灰", "40灰色", 48 idx = 48 Case "濃い青緑", "濃い青緑色", "濃青緑", "濃青緑色", 49 idx = 49 Case "シーグリーン", "シーグリーン色", 50 idx = 50 Case "濃い緑", "濃い緑色", "濃緑色", 51 idx = 51 Case "オリーブ", "オリーブ色", "焦げ茶色", 52 idx = 52 Case "茶", "茶色", "ブラウン", 53 idx = 53 Case "プラム", "プラム色", 54 '←この色は不具合が発生？ idx = 54 Case "インディゴ", "インディゴ色", 55 idx = 55 Case "80%灰", "80%灰色", "80灰", "80灰色", 56 idx = 56 Case Else idx = 100 End Select End Function '※ここまで ---- ビックリです。。こんなたくさんあるのでしょうか？？？？？ 何処からコピーすればよいのか？分かりません・Function 色作業(adrs As Range, work As String, Optional colr As Variant = 0) からコピーして行いましたが？？ =色作業(N8:N675,"文字色のカウント","赤")で入れて見ましたがエラーが？？ 全然難しすぎて・・・ ---- >何処からコピーすればよいのか？分かりません 全部です＾＾； 　 '※ここから '------------------------------ Option Explicit Sub auto_open() ：　：　：　：　：　 End Function '※ここまで 　 （ししょ〜のスレに勝手にコメント追加しましたm(_ _)m） 　 ちなみに、説明したからお分かりいただいていると思いますが、、、 ''条件付書式''には、対応できません。 ししょ〜も、こう仰っています。 '' >えっと、これはこのスレに関係ありまへんのんやろけど''、色の問題で色々ご苦労なさ >ってらっしゃる御方が思いの外多いみたいなんで基本的な色関数（イロですよ（笑 >を遊びがてら作ってみましたワ。 #しかし、ししよ〜！これは、使い勝手がありますぞ〜！！！（3つWWW （キリキ）（〃⌒o⌒)b ---- またまたすみません。赤のカウンターと黒の合計を出す時はどういう？式を入れればよいのですか？ (例）黒の場合（範囲がN8:N676　Ｎ682にどのような式を？）Ｎの682に答えです (例）赤の場合（範囲がO8:N676　O682にどのような式を？）Oの682に答えです お願いします。。 ---- あんまりこういうこと言いたくないんですがね。。。 こういった掲示板は、言葉のキャッチボールだと思うんですよ。 書いてあることをお試しになりました？ 試したならどのように試しました？ うえ〜の方にも書きましたが、 >このように、ためした結果を書いていただくと、具体的にレスがつけやすいっすね〜♪ 結果を書きましょうよ？ >(例）黒の場合（範囲がN8:N676　Ｎ682にどのような式を？）Ｎの682に答えです どのように試した結果わからなくて、何処にどのような数式を書きましたか？ また、その数式を書くために使ったユーザー定義関数はどれをお使いになったのですか？ >(例）赤の場合（範囲がO8:N676　O682にどのような式を？）Oの682に答えです 同上 弥太郎さんの説明文抜粋 >第１引数には範囲を指定します。これは説明不要と思われますので省略しときまっせ。 >第２引数には↑の作業内容を"で囲んだ命令が必要です。 > >1)のキーワードはセルとカウント >2)のキーワードはセルと計 >3)のキーワードは文字とカウント >4)のキーワードは文字、数値と計 > >になっとります。 >ですから欲しいデータにご自分の分かりやすい表現で作業内容を指定すればええんと >ちゃいまっか。 >例えば"色の付いたセルのカウント" とか"色つき文字の合計" とか・・・ > >第３引数には、色を指定します。これは省略可能で、省略すれば全ての色が指定色 >になります。 > >１例を挙げると、=色作業(A1:D30,"色つきセルの合計","黄")と書くと >黄色のセルの数値を合計してくれますし、"黄"を省略すると色の付いたセルの合計を >を算出してくれます、多分（笑 　 '' =色作業(A1:D30,"色つきセルの合計","黄")''です。 　 あんまりこういう事言うと、意地悪みたいですかね〜？ そういうキャラじゃ無いと思ってるんですがね。。。 これでいかがでしょう？ 弥太郎ししょ〜の最新版ユーザー定義関数で、 N682 =色作業(N8:N676,"色つき文字の合計","黒") O682 =色作業(O8:N676,"色つき文字のカウント","赤") ~~~~ ここが入力間違いなら、「O8:O676」に変更してください。 #初心者と言えば、σ(^o^;)も似たようなものです。 #多分エクセル暦2年未満ですから。。。 （キリキ）（〃⌒o⌒)b ありがとうございます。しかし式を入力した所マクロ画面がでてエラーになってしまいます。 （エラー１)　SubまたはFunctionが定義されていません。 If colr <> 0 Then colr_idx = idx(colr)の　=の後のidxが黒くなります。 （エラー２) Function 色作業(adrs As Range, work As String, Optional colr As Variant = 0) この部分が黄色く色付けされてしまいます。 最後に閉じようとすると＜このコマンドを使うとデバッグは中断します。＞ と出てしまうのですが？？変更がわかりません？？教えて下さい。。 ---- 単純に全てのコードをコピーしていないのでは？ > End Function >'※ここまで のところまで全部コピーしていますか？ （やっちん） 以下のようにコピーしましたが？？式を入力すると＃VALUE!と出てしまいます？？ '------------------------------ Option Explicit Sub auto_open() Application.MacroOptions _ macro:="色作業", _ Description:="色付セル、色つき文字の計算及びカウントを引き受けまっせ。" _ & Chr(10) & "Adrs=範囲 Work=作業内容 例 セル色のカウント Colr=色の指定 省略すると全色指定になる" End Sub '------------------------------------------ Function 色作業(adrs As Range, work As String, Optional colr As Variant = 0) Dim colr_idx As Integer, work_case As Integer, get_type As Integer Dim totl As Double Dim c Application.Volatile colr = IIf(colr Like "*灰*", StrConv(colr, vbNarrow), colr) work_case = work_type(work) If colr <> 0 Then colr_idx = idx(colr) If colr_idx = 100 Or work_case = 5 Then 色作業 = "BuBuuu！(^ ^;" Exit Function End If If colr_idx = 1 Then Select Case work_case Case 1 For Each c In adrs If IsNumeric(c) And c.Interior.ColorIndex = 1 Then totl = totl + c.Value End If Next c Case 2 For Each c In adrs If IsNumeric(c) And c.Font.ColorIndex = 1 Or _ c.Font.ColorIndex = xlAutomatic Then totl = totl + c.Value End If Next c Case 3 For Each c In adrs If c.Interior.ColorIndex = 1 Then totl = totl + 1 End If Next c Case 4 For Each c In adrs If c <> "" And c.Font.ColorIndex = 1 Or _ c.Font.ColorIndex = xlAutomatic Then totl = totl + 1 End If Next c End Select Else If work_case < 3 Then For Each c In adrs get_type = IIf(work_case = 1, _ c.Interior.ColorIndex, c.Font.ColorIndex) If IsNumeric(c) And get_type = colr_idx Then totl = totl + c.Value End If Next c Else For Each c In adrs If work_case = 3 Then If c.Interior.ColorIndex = colr_idx Then totl = totl + 1 End If ElseIf work_case = 4 Then If c <> "" And c.Font.ColorIndex = colr_idx Then totl = totl + 1 End If End If Next c End If End If Else For Each c In adrs get_type = IIf(work_case = 1 Or work_case = 3, _ c.Interior.ColorIndex, c.Font.ColorIndex) Select Case work_case Case 1, 2 If IsNumeric(c) And get_type > 1 Then totl = totl + c.Value End If Case 3 If get_type > 0 Then totl = totl + 1 End If Case 4 If c <> "" And get_type > 0 Then totl = totl + 1 End If End Select Next c End If 色作業 = totl End Function '---------------------------------- Private Function work_type(ByVal work As String) As Integer If work Like "*セル*" And (work Like "*計*" Or work Like "*トータル*") Then work_type = 1 ElseIf (work Like "*文字*" Or work Like "*数値*") And (work Like "*計*" _ Or work Like "*トータル*") Then work_type = 2 ElseIf work Like "*セル*" And work Like "*カウント*" Then work_type = 3 ElseIf (work Like "*文字*" Or work Like "*数値*") And work Like "*カウント*" Then work_type = 4 Else work_type = 5 End If End Function '----------------------------------------- Private Function idx(ByVal colr As Variant) As Integer Select Case colr Case "黒", "黒色", "自動", "自動色", "xlAutomatic", "Auto", 1 idx = 1 Case "白", "白色", "ホワイト", 2 idx = 2 Case "赤", "赤色", "レッド", 3 idx = 3 Case "明るい緑", "明るい緑色", "薄緑", "薄緑色", "淡緑色", "若緑", 4 idx = 4 Case "青", "青色", "ブルー", 5 idx = 5 Case "黄", "黄色", "イエロー", 6 idx = 6 Case "ピンク", "ピンク色", "マゼンダ", "マゼンダ色", "桃色", 7 idx = 7 Case "水色", "シアン", "シアン色", 8 idx = 8 Case "濃い赤", "濃い赤色", "濃赤色", 9 idx = 9 Case "緑", "緑色", "グリーン", 10 idx = 10 Case "濃い青緑", "濃い青緑色", "濃青緑色", "濃青緑", 11 idx = 11 Case "濃い黄", "濃い黄色", "濃黄色", "黄土", "黄土色", 12 idx = 12 Case "紫", "紫色", "バイオレット", 13 idx = 13 Case "青緑", "青緑色", 14 idx = 14 Case "25%灰", "25%灰色", "25灰", "25灰色", 15 idx = 15 Case "50%灰", "50%灰色", "50灰", "50灰色", 16 idx = 16 Case "スカイブルー", "空色", 33 idx = 33 Case "薄い水色", "薄水色", "淡水色", 34 idx = 34 Case "薄い緑", "薄い緑色", "薄緑", "薄緑色", 35 idx = 35 Case "薄い黄色", "薄黄色", "淡黄色", "淡黄", 36 idx = 36 Case "ペールブルー", "ペースブルー色", 37 idx = 37 Case "ローズ", "ローズ色", "バラ色", 38 idx = 38 Case "ラベンダー", "ラベンダー色", 39 idx = 39 Case "ベージュ", "ベージュ色", 40 idx = 40 Case "薄い青", "薄い青色", "薄青色", "淡青色", 41 idx = 41 Case "アクア", "アクア色", 42 idx = 42 Case "ライム", "ライム色", 43 idx = 43 Case "ゴールド", "ゴールド色", "黄金色", "黄金", 44 idx = 44 Case "薄いオレンジ", "薄いオレンジ色", "淡オレンジ色", 45 idx = 45 Case "オレンジ", "オレンジ色", "橙色", 46 idx = 46 Case "ブルーグレー", "ブルーグレー色", "青灰色", 47 idx = 47 Case "40%灰", "40%灰色", "40灰", "40灰色", 48 idx = 48 Case "濃い青緑", "濃い青緑色", "濃青緑", "濃青緑色", 49 idx = 49 Case "シーグリーン", "シーグリーン色", 50 idx = 50 Case "濃い緑", "濃い緑色", "濃緑色", 51 idx = 51 Case "オリーブ", "オリーブ色", "焦げ茶色", 52 idx = 52 Case "茶", "茶色", "ブラウン", 53 idx = 53 Case "プラム", "プラム色", 54 '←この色は不具合が発生？ idx = 54 Case "インディゴ", "インディゴ色", 55 idx = 55 Case "80%灰", "80%灰色", "80灰", "80灰色", 56 idx = 56 Case Else idx = 100 End Select End Function ---- 入れた式を載せてください。 （やっちん） ---- 単にダブルクォーテーション（"）を入れていないだけではないでしょうか？ (ROUGE) ---- N682 =色作業(N8:N676","色つき文字の合計","黒") O682 =色作業(O8:N676","色つき文字のカウント","赤") 入れましたがだめです・・・先ほどと同じです・・？ ---- > N682 =色作業(N8:N676","色つき文字の合計","黒") ~~ここのダブルクォーテーションは不要です。 (ROUGE) やはり同じです・エラーが出てしまいます。（泣） ---- 1度ブックを保存してから開きなおしてもダメですか？ （やっちん） ---- >やはり同じです・エラーが出てしまいます。（泣） まさかとは思いますが、、、 N682 =色作業(N8:N676,色つき文字の合計,黒) すべてのダブルクォーテーションを取っちゃったりしてませんよね？？？ 　 σ(^o^;)が答えも書いたんだけどな・・・ 　 >N682 =色作業(N8:N676,"色つき文字の合計","黒") >O682 =色作業(O8:N676,"色つき文字のカウント","赤") 　 このままコピペしても駄目なんでしょうか？ （キリキ）（〃⌒o⌒)b ---- あっら〜、キリキせんせぇにユーザー関数新作発表会（そんなん、あらへん）に出展す る(願わくば条件式書式も加えて貰えるよう・・）のに下見をお願いするため披露した だけであって、HHさんの解決策に呈示したもんではありまへんのに〜。 私のレスを読んで貰うたらご理解頂けると思いまんねんけどなぁ。（笑 HHさんのおっしゃる数式の入ったセルを除外しとりまへんし、ましてや条件 付書式の色変更まで対応する様な優秀な関数ではありまへんねんで、えぇ。 その証左に前掲したNot c.HasFormulaも使うてまへんやろ？ あのぅ、ついでやから申しあげときますけど、 >=色作業(N8:N676","色つき文字の合計","黒") 残念ながら今のところそこまで融通の利く関数に仕上がっておりまへん。 今暫く=色作業(N8:N676,"色つき文字の合計","黒")と書いてくらはい。 愛弟子初めやっちんさんまで引っ張り出してえらいすんまへん。（笑 　　年貢は半額にせなしゃあないかなぁ・・・（弥太郎） ---- >年貢は半額にせなしゃあないかなぁ・・・ （キリキ）（〃⌒o⌒)V ---- 呑んで喋った事はすぐ忘れてひまう・・・（笑 　　　　（弥太郎） ---- ご心配なく！ きっちり帳面につけときますさかい〜（笑 （キリキ）（〃⌒o⌒)φサラサラ 皆さんお騒がせしてます。 なんとなく分かったような？？ N682 =色作業(N8:N676,"色つき文字の合計","黒") O682 =色作業(O8:N676,"色つき文字のカウント","赤") N8:N676　O8:N676の中に数字だけではなく文字も含まれているのですが？ マクロ式の何処を直せば？？？他のファイルで行ったところＯＫで（数字だけなら） 文字を入れると駄目でした・・・ ---- >マクロ式の何処を直せば？？？ なぜマクロを直す必要があるのです？ 　 HHさん もう一度、上から一つずつお読みください。 そして、上から一つずつお試しください。 　 ヒント >1)のキーワードはセルとカウント >2)のキーワードはセルと計 >3)のキーワードは文字とカウント >4)のキーワードは文字、数値と計 1)は、パターン色が付いたセルの数を数える 2)は、パターン色が付いたセルの数値の合計（数値以外があるとエラーです） 3)は、色の付いた文字のセルの数を数える 4)は、色の付いた数値の合計（文字があるとエラーです） （キリキ）（〃⌒o⌒)b 文字があるとエラーがでるとあるということは、駄目ということで？ 駄目ならあきらめます。。。（泣）ありがとうございました。 ---- ですから、弥太郎さんの最初のマクロで出来たのではないのですか？ 条件付書式と両立するのでしたら、SUMPRODUCT関数で足す。 そして何回も言いますが、、、 今回のコードは、HHさんのためではございません。 最初の、「red」や「blacktotal」をお使いください。 そして、出来ればマクロというものをがんばって勉強してみてください。 今お使いになっているのは、ユーザー定義関数というものです。 その名の通り、「ユーザー」が「関数」を作るものです。 マクロにはそれ以外に色々あります。 σ(^o^;)が最初に提示したものもマクロです。 コレは、実行すれば勝手に決められた場所に決められたこと（今回は数）を 出すように作りました。 色々あるのです。HHさんが思っているものは、マクロでもほんの一部です。 そして、少しでも勉強すれば今回のような遠回り？見たいな事は無かったはずです。 ・何処までコピペすればいいのか ・ダブルクォーテーションが何処に必要か などは本来、基本的なことです。 どうやら、HHさんは勝手に決め付け（思い込み）をして勝手にパニックになっている だけのような気がします。。。 落ち着いてやれば出来たでしょ？ 偉そうなことを言っちゃいましたが、HHさんのためになればと思い あえてレスしました。 　 （キリキ）（〃⌒o⌒)b ---- ししょ〜のコードでは　IsNumeric　を使ってますので、 数値でないものが含まれていても合計は出す（エラーは出ない）はずですよ〜。 (ROUGE) ---- to ROUGE義弟へ（笑 　 moichido miteminahare 　 Select Case work_case no Case 2 Or _ no usiroyade~ 　 （キリキ）（〃⌒o⌒)b ---- hontoda... brother no TAX ha herukotodesyou ^^ (ROUGE) ---- あ〜あぁ、とうとうHHはんを泣かせてしもた。 知〜らんで、知〜らんで。 キリキ屋にROUGE屋、お主等も悪よのぅ（笑 HHさん、めげずにがんばりまひょでぇ！ このばやい年貢は減ってもkasiori(2juuzoko no) ga hituyou ni naruka...(smile) 　　　　(yotarou) gya!