[[20181019235030]] 『塗りつぶしセルカウントと%表示』(むら) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『塗りつぶしセルカウントと%表示』(むら)

 セルの塗りつぶしを数える方法ですが、下記コードを記述します。
 質問1、一つ置きに塗りつぶしのセルをカウントしたい。
 質問2、カウントしたセルを%表示にしたい
 質問2の例
  カウントされた数字が5個に対してずべて塗りつぶしされていれば10個だと5/10で50%の進捗となるようにしたいのです。

 Function CountColorA(Rng As Range) As Long

  Dim myRng As Range
  Dim Col_cnt As Long

  Application.Volatile
  Col_cnt = 0

  For Each myRng In Rng
    If myRng.Interior.ColorIndex > 0 Then
      Col_cnt = Col_cnt + 1
    End If
  Next myRng
  CountColorA = Col_cnt

End Function

 色をカウントさせるのに
 =CountColorA(C10,C12,C14,C16,C18,C20,C22,C24,C26,C28,C30,C32,C34,C36)+NOW( )*0
 ご回答いただける方がおりましたらよろしくお願いいたします。

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 提示されたコードは、動くのでしょうか?

 多分、因みに Application.Volatile は、意味がないと思う。
 色を変えても再計算されるわけがないので・・・。
 %は、自分でやってください。

 Function CountColorA(ParamArray Rng()) As Long
  Dim myRng As Variant
  Dim Col_cnt As Long
  'Application.Volatile
  Col_cnt = 0
  For Each myRng In Rng
    If myRng.Interior.ColorIndex > 0 Then
      Col_cnt = Col_cnt + 1
    End If
  Next
  CountColorA = Col_cnt
 End Function
(BJ) 2018/10/20(土) 03:10

 訂正。
 Application.Volatile
 が無いと、F9押しても再計算されなかった????
 この辺、微妙でよく解らない。
(BJ) 2018/10/20(土) 03:25

 >カウントされた数字が5個に対してずべて塗りつぶしされていれば10個だと5/10で50%の進捗となるようにしたいのです。

 1.「カウントされた数字」って何ですか?
   塗りつぶしのセル且つ数字が入っているセルの数ですか?

 2.「数字」って、数値(数値型)・数字(文字型)のどっちですか? それとも両方ですか?

 3.+NOW( )*0が数式に付加されている場合、Application.Volatileは要らないです。

 4.飛び飛びのセルなので、
         カッコで括る必要があります。
          ↓ 
   =CountColorA((C10,C12,C14,C16,C18,C20,C22,C24,C26,C28,C30,C32,C34,C36))+NOW( )*0

(半平太) 2018/10/20(土) 11:30


 ご回答ありがとうございいます。返信が遅くなり申し訳ございませんでした。

 BJ様
 上記のコードでは動いております。F9を押しても再計算されております。

 半平太様
 塗りつぶしされたセルをカウントしておりますが、すべてのセルを塗りつぶしされた場合には10とカウントされて100%になりますが、すべてが塗りつぶしされるまでの進捗を把握できるようにしたいのです。

 1.塗りつぶしされたセルのことで、セルの中に数字は入っておりますが数字はカウントしなくていいんです。

 2.数字というのは塗りつぶしされたセルをカウントした数字のことになります。この場合は数値型になるのでしょうか?

 3.削除いたしました。

 4.ダブルカッコで動くようになりました。

 上記の回答でわかりますでしょうか?

(むら) 2018/10/20(土) 23:12


 事情は分かりました。

 すると、この場合、分母は14と言うことになりますよね?
      ↓
  =CountColorA((C10,C12,C14,C16,C18,C20,C22,C24,C26,C28,C30,C32,C34,C36))

 すると、
  =CountColorA((C10,C12,C14,C16,C18,C20,C22,C24,C26,C28,C30,C32,C34,C36))/14+NOW( )*0
 でいいことになります。                          ↑

 けど、多分それじゃイヤだと言うことになるのでしょうね。
 何がイヤなのか、その心を説明してください。

 私もなんかイヤだなぁと感じるんですが、その心は、一つずつセルを指定しなければならないことですね。

 こんな関数でいけるようにしたいじゃないですか。
    ↓
 =CountColorStep2(C10:C36)/ROUNDUP(ROWS(C10:C36)/2,0)+NOW( )*0

 もっと言えば、こんな関数で済ませられればもっといいかも。ただ、汎用性は低くなるデメリットが生じる。
         ↓
 =CountColorStepX(C10:C36,x)+NOW( )*0
             ↑
            飛び幅を指定できるようにし、パーセンテージで返ってくる関数

(半平太) 2018/10/20(土) 23:38


 いいアイデアが浮かびました。

 =CountColorStepX(C10:C36,色番号,x)+NOW( )*0
                ↑ ┃↑
       色番号が指定でき ┃ 飛び幅を指定できるようにし、
       指定しない場合は ┃ 何個色が付いていたかと全何個だったかを配列で返させる。
       色付き全てにする  ┃ それなら通常は配列の一番目だけ使い、
                ┃ パーセンテージを出したい時は2番目も利用する

(半平太) 2018/10/20(土) 23:52


 半平太様
 ご回答ありがとうございます、
 分母は14になります。
 最後にいただいた関数ですと、エラーで「#NAME?」になりました。
(むら) 2018/10/21(日) 00:02

横からですし、回答ではないですけど、
>Function CountColorA(Rng As Range) As Long 〜 と投稿されているので
「CountColorA」がユーザー定義関数なのは理解できているんですよね?

そうなると、なんで
>最後にいただいた関数ですと、エラーで「#NAME?」になりました
っていう返答(質問?)になるんです?
そりゃ作ってなければそうなるよね。ってなるように思うんですが・・・

(もこな2) 2018/10/21(日) 00:29


追加。

一度、Functionプロシージャではなく、Subプロシージャで作成してみて、ステップ実行しながら望む動きになっているか確認してみてはどうでしょうか?
(返り値をLong型としているところも気になりますし・・・)

半平太さんのアイデアを拝借するとこんな感じでは?

    Sub テスト()
        Dim セル範囲 As Range: Set セル範囲 = Range("C10:C36")
        Const 色番号 As Long = 3
        Const ステップ数 As Long = 2

        Dim i As Long, x As Long, y As Long

        Stop

        For i = 1 To セル範囲.Count Step ステップ数
            x = x + 1
            If セル範囲.Cells(i).Interior.ColorIndex > 0 Then y = y + 1
        Next i

        MsgBox y & "/" & セル範囲.Count & vbCrLf & Format(y / x, "0%")

    End Sub

(もこな2) 2018/10/21(日) 03:42


ミスりました。

 誤 MsgBox y & "/" & セル範囲.Count & vbCrLf & Format(y / x, "0%")
                             ↓ 
 正 MsgBox y & "/" & x & vbCrLf & Format(y / x, "0%")
(もこな2) 2018/10/21(日) 03:44

 私が独り言みたいに書いたのがマズかったです。 m(__)m

 > 分母は14になります。

 それで、取りあえず求めるものは算出できますよね?
 そんなやり方で良ければ、この質問は決着です。

 良いか、悪いかまだ結論をお聞きしていないですし、
 悪いとした場合の改善希望もお聞きしていないですから、
 私なりのアイデアを述べたに過ぎません。

 従って、何か具体的に作ったものはありません。
 なので、当然こうなります。
         ↓
 >最後にいただいた関数ですと、エラーで「#NAME?」になりました。

 更にアイデアとしては、返ってくる配列の中身を3つにして、
 3つ目はパーセンテージにすることもあり得ます。

 要は、むらさんがこの問題をどこまで汎用性を持たせたいと思っているのか、
 汎用性はどうでもよくてサクッと求めるものを算出したいと思っているのかに掛かっています。

(半平太) 2018/10/21(日) 09:10


 皆様いろいろとありがとうございます。私がやりたいことはできましたが・・・
 欲をいいますと、C列からL列まで塗りつぶしがを進捗に応じて4色の色を付けていくのですが、C10:E36は黄色、E10:H36は緑、I10:K36は青、L10:L36は赤で塗りつぶしするようにしておりまして、最終的に赤でL列すべての塗りつぶしがされれば200%になります。
 途中の緑がすべて塗りつぶしされれば100%になります。
 ただ必ず塗りつぶしその列とはかぎりません。
 たとえばE列ですべて緑が塗りつぶしできない場合は、次の列のF列がすべて緑に塗りつぶしされていればF列で100%になります。
 かなりややこしいのです。

 ややこしいのですが、列の色別にパーセント表示は可能でしょうか?
 通常はF列で黄色すべて塗りつぶしされて100%ですが、先ほど書きましたようにE列で100%になる可能性やD列100%になる可能性もあります。
 説明が下手すぎてしみません。
(むら) 2018/10/21(日) 23:44

 1つ書き忘れたのですが、F9で再計算されますがF9を押さなくてもよい方法ってあるのでしょうか?
 塗りつぶししたり塗りつぶしなしにした場合に自動で再計算されるようにできますでしょうか?
 ご回答いただければ幸いです。
(むら) 2018/10/22(月) 00:01

 自分で色変更ボタンを押したイベントを作って、再計算とか・・・。
 2007以降では、Javaが関係しているとか?で、やった事も触った事もないです。

 >列の色別にパーセント表示は可能でしょうか?
 可能もくそも、自分で計算すれば良いんじゃないですか?
 どこに表示しようとしているのか知らないけど・・・。
(BJ) 2018/10/22(月) 02:55

 ややこしいので、私が対応できるのは以下2つのプログラムのみ

 1.CountColorStepX
   色付きセルを数えて、必要に応じて全体に対する割合を出す

 2.clrNoCheck
  セルの色番号を調べるプログラム

 あとは、そちらで臨機応変にその関数を組み合わせてもらうしかないです。

 構文
 1.CountColorStepX(対象範囲,色番号,何個置き,区分)

  対象範囲:1列に限定していません。(複数列に対応可です)
  色番号 :無色以外全ての場合 "ALL" と文字で入れる。
  飛び飛び:連続は0、一つ置きは1、・・・
  区分  :1= セル数、2= 全セル数、3= 割合

 2.clrNoCheck(セル)
  セル:ひとつのセルだけ指定

 3.具体例
   今回の例だと、色付きは全て、一つ置き、割合、なので

   =CountColorStepX(C10:C36,"ALL",1,3)+NOW( )*0

 >F9で再計算されますがF9を押さなくてもよい方法ってあるのでしょうか?

 私は、その方法があるかどうか知らないです。(常識的には無いです)

 なお、既にどっかのセルが同じ色で塗りつぶしてあるなら、
 そのセルの書式をコピーしてきて、書式だけ貼り付けをすれば自動的に再計算されます。

 ’-----標準モジュールに貼り付け -----------------------------

 Function clrNoCheck(rng As Range)’色番号を調べる
     If rng.CountLarge = 1 Then
         clrNoCheck = rng.Interior.Color
     End If
 End Function

 ’色付きセルを数えて、必要に応じて全体に対する割合を出す
 'clrNo : 無色以外なら"ALL"と文字で入れる
 Function CountColorStepX(rng As Range, clrNo, stp As Long, kbnTP As Long) As Double
     Dim RW As Long, CL As Long, TTL As Long, Colored As Long
     Dim Tmp

     If stp < 0 Or 100 < stp Then Exit Function
     If kbnTP < 0 Or 3 < kbnTP Then Exit Function

     For CL = 1 To rng.Columns.Count
         For RW = 1 To rng.Rows.Count Step stp + 1
             TTL = TTL + 1
             Select Case clrNo
                 Case "ALL"
                     Colored = Colored + IIf(rng.Cells(RW, CL).Interior.ColorIndex <> xlNone, 1, 0)
                 Case Else
                     Colored = Colored + IIf(rng.Cells(RW, CL).Interior.Color = clrNo, 1, 0)
         End Select
         Next RW
     Next CL

     Select Case kbnTP '1=該当数,2=総数,3=パーセンテージ
         Case 1: Tmp = Colored
         Case 2: Tmp = TTL
         Case 3: Tmp = Colored / TTL
     End Select

     CountColorStepX = Tmp
 End Function

(半平太) 2018/10/22(月) 10:12


 半平太様
 ありがとうございます。
 同じ列に別な色がいても100%になるのはなぜでしょうか?
(むら) 2018/10/23(火) 07:26

 > 同じ列に別な色がいても100%になるのはなぜでしょうか?

 どういう数式を使いましたか?

 これですか?
   ↓
  =CountColorStepX(C10:C36,"ALL",1,3)+NOW( )*0

 当初、そちらのコードは色を区別していないかったので
 例としてそう書いたのですが、
 色を区別するなら "ALL" の所は目的の「色番号」に変えてください。

 色番号は、無害なセルにこう入力すれば調べられます。
            ↓
          =clrNoCheck(目的の色が付いている一つのセル)

(半平太) 2018/10/23(火) 08:41


 半平太様

 ご回答ありがとうございます。
 数式の色はこちらになりますがこれでよいのでしょうか?
 =CountColorStepX(C10:C40,"10092543.10092492.16764159.13433777",1,3)+NOW( )*0
(むら) 2018/10/23(火) 11:10

 > =CountColorStepX(C10:C40,"10092543.10092492.16764159.13433777",1,3)+NOW( )*0

 1.色指定をする場合は1種類のみです。
     複数の色について一緒に何か算出したい場合は、
     上の関数を臨機応変に組み合わせる必要があります。

 2.また、"ALL" 以外は " " で囲わないでください。
     (そのまま数値として入力)

 何を算出したいのか説明いただければ、こっちで数式サンプルを書きますよ。

(半平太) 2018/10/23(火) 11:21


 半平太様

 ありがとうございます。
 算出したいのはC10:C40までに付いてる色の数でパーセンテージを出したいのです。
 縦列Cで色(10092543)が9/10で、残り1つのせるは塗りつぶしなだとすると90%になりますが、9/10で他の色(10092492)が付いていたとしても90%になるようにできますか?
 上記に書きましたパーセンテージを表示させる箇所で4色すべてを入れて割合が多いものでパーセンテージを表示させたいのです。
(むら) 2018/10/23(火) 15:15

 追記になります。
 初めは緑で100%で赤で200%という書き方を上記でさせていただきましたが、色別ごとに100%になるように表示させたいです。

(むら) 2018/10/23(火) 15:19


 > 縦列Cで色(10092543)が9/10で、残り1つのせるは塗りつぶしなだとすると90%になりますが、

  どういう計算ですか?

  一セル置きだと、16セルですよね?
  その内1つだけ塗りつぶし無しなら、15/16 → 93.75% ですよね?

  二セル置きなのですか?

 >9/10で他の色(10092492)が付いていたとしても90%になるようにできますか?

 10092543しか数えない数式を作るんですから、自然にそうなります。

 >上記に書きましたパーセンテージを表示させる箇所で4色すべてを入れて割合が多いものでパーセンテージを表示させたいのです。

 それは、面倒でも一つずつ求めて、その中から最大値を採用する必要があります。

 例(2セル置きと仮定します)
 ↓
  =MAX(CountColorStepX($C$10:$C$40,10092543,2,3),CountColorStepX($C$10:$C$40,10092492,2,3),CountColorStepX($C$10:$C$40,16764159,2,3),CountColorStepX($C$10:$C$40,13433777,2,3))+NOW( )*0

(半平太) 2018/10/23(火) 16:11


やりたいことが私にはよくわからないけど、どこかのセルの”塗りつぶしの色”を基準に、指定したセル範囲にセルがいくつあり、そのうちいくつが”同じ”塗りつぶし色なのかを求めれば、割合はわかりますよね。

    Function 指定色の割合(セル範囲 As Range, 凡例セル As Range) As Double
        Dim MyRNG As Range, c As Long

        For Each MyRNG In セル範囲
            If MyRNG.Interior.Color = 凡例セル.Cells(1).Interior.Color Then c = c + 1
        Next MyRNG

        指定色の割合 = c / セル範囲.Count
    End Function

色ごとに割合調べて、全部足したらそりゃ100%になるでしょうけど、そういうことが聞きたいわけではないんですよね。
(もこな2) 2018/10/23(火) 18:23


 半平太様
 ご連絡が遅くなりまして申し訳ありません。
 書いていただいた関数で私がやりたいことはできました。ありがとうございます。

 フォームにてボタンを作成したのですが、パレットのカラーコードでペイントしているのですが、教えていただいた=clrNoCheck(色)ででたコードでの色付けはできますでしょうか?

 Private Sub CommandButton2_Click()
    Painting 36 '→ 10092543'
    Unload Me
 End Sub

 もなこ2様
 いろいろと考えていただきありがとうございます。
 やりたいことはそういうことになります。
(むら) 2018/10/26(金) 22:37

  >フォームにてボタンを作成したのですが、パレットのカラーコードでペイントしているのですが、
  >教えていただいた=clrNoCheck(色)ででたコードでの色付けはできますでしょうか?

  パレットのカラーコードとは「ColorIndex」のことですね?

  今回、勉強してみたら、ColorIndexは絶対的な色を
  指定するものじゃないことが分かったので、私は使う気にならなかったです。

  むらさんがそれを使いたいと言うことなら

  以下、1行(★)変更して使ってください。(再度、インデックス番号を調べる必要があるのは分かっていますね)

  Function clrNoCheck(rng As Range)
      If rng.CountLarge = 1 Then
          clrNoCheck = rng.Interior.ColorIndex ’←Colorから変更 ★
      End If
  End Function

  私のレスはこれで最後です。  

(半平太) 2018/10/26(金) 23:02


 >以下、1行(★)変更して使ってください。

 いや、それだけじゃなかったです。ごめんなさい m(__)m

 再検討する気が起きないので、他の回答者のレスを待ってください。

(半平太) 2018/10/26(金) 23:05


 ColorIndexを再度調べてても、黄緑ともう少し薄い黄緑でも同じ35なのでどうしたらいいのか分かりませんのでどなたか教えいただける方はおりますでしょうか?宜しくお願いします。

(むら) 2018/10/26(金) 23:29


あぁ 話が続いていたのですね。。。すっかり忘れてました。

とりあえず、↓の記事をご一読願います。
http://officetanaka.net/excel/vba/graph/24.htm
http://officetanaka.net/excel/vba/graph/25.htm

読んでいただくとわかるかと思いますが、 ColorIndexで35だとしても、おっしゃるように黄緑ではない場合もあるんですよ。

なので、Excel2010(Excel2003よりあとのバージョン)ではColorプロパティの方を使うことをおすすめします。

>やりたいことはそういうことになります。
なら、提示のもので出来ますよね。疑問点はどこですか?
(もこな2) 2018/10/27(土) 00:50


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.