[[20040206172429]]　『色付きセルかつ空白でないセルを数えたい』（HIR）　ページの最後に飛ぶ

『色付きセルかつ空白でないセルを数えたい』（HIR）

過去ログより下記マクロを発見しました。

 Function FCC(adrs, clr)
  sm = 0
   For Each ad In adrs
    fci = ad.Interior.ColorIndex
    cv = ad.Value
    If fci = clr Then
     sm = sm + 1
    End If
   Next
 FCC = sm
 End Function

これだと色付きのセル数を全て数えますが、
色付きかつ空白でないセルの個数を数えたい場合は
どうしたらできますでしょうか？

ご教授よろしくお願い致します。

 念のためお知らせしますが、
 このVBAは指定された色のセルの数(kazu)を数えるコードです、
 作者より。
 （kazu）

 kazuさんのVBAを少しいじりました。

 Function FCC(adrs)
    Dim adval As String
    Dim sm As Integer, fci As Integer
    Dim ad
    sm = 0
    For Each ad In adrs
        fci = ad.Interior.ColorIndex
        adval = ad.Value
        If fci > 0 And adval <> "" Then
            sm = sm + 1
        End If
    Next
    FCC = sm
 End Function

 こんな感じでしょうか？（ケン）

 数独中級者さんこんばんは。
 先手打つとは卑怯なり。
 kazuさんの作曲やったらあんまり編曲したらアカンと思うて、書き直しました。

 や～めた！
 ここへコピペして見比べたら、イケメン　ケンさんと全く同じやんか、は～っ
 Applicati.Volatileだけワシの勝ち？（弥太郎）

 弥太郎さん、こんばんはm(_ _)m
恐れ入ります。勝手に編曲して怒られるでしょうか？こわ～いよ～
（ケン）　何故か？Application.Volatileがなくても再計算してくれます。

 [著作権の侵害じゃ]と怒ろうとおもっていたのですが、思わぬ発見で中和。

 > 何故か？Application.Volatileがなくても再計算してくれます。

 私もこのケンが気になったので、追試しました。

 問題のポイントは引数の渡し方にあるようです。

 変化しない clr があるとセルの色が変化しても、再計算しないようです。

    Function FCC(adrs, clr)

    Function FCC(adrs)

 （kazu）

 なるほど。分かったような？分からないような？
取りあえず、お許しが出たようなので、ほっと一安心。ホッ
有難うございます。勉強さしてもらいました。（ケン）

   ケンさ～ん、勘違いしたらいけまへん。
 わたしゃApplication.Volatileの働きのことを言うとるんと違いまっせ。
 あんさんのコードより一行多い事を自慢してまんねんで、えぇ。
 ふん、どんなもんでぇ。-

 >私もこのケンが気になったので、追試しました。
 以前、再計算されない関数を作っておうじょうした事がありましたんで、それ以来
 どの関数でもこれ放り込んでますワ。
 カラーの個数を勘定する関数も作った覚えがありまんねんけどVolatileを使っても
 再計算されなかったと思うんですが・・・？？？
　　　　（弥太郎）

 「備えあれば、なんとやら」ですか。違う？
そうですね。また一つ上がれました。
（ケン）今、弥太郎さんの右足膝位かなぁ～

（kazu）様、（ケン）様、ありがとうございました。

 私の質問の仕方が悪かったので申し訳ないのですが、
 実は「”指定された色”でかつ、空白でないセルの数を数えたい」
 のです。
 再度お教えいただきたくお願いします。
　　　　　　　　　　　　　　　　（HIR）

 Functionプロシージャが良いのでしょうか？ Subでも構わない？ 
 ちなみにセルを調べる範囲は、シート上の全範囲ですか？
 ループ処理しますので、範囲は出来る限り限定した方が処理は速くなりますが・・。

  (INA)

 見当違いなことを書いてしまったらすみません。
 マクロ実行時に検索範囲(A1:A300等)と色番号を入力し検索したいと思っています。
 関数名を"ABC"としたなら、”=ABC(A1:A300,15)”という感じです。
                                                    （HIR）

 こんな感じでしょうか？

 Function ColorCount(ByVal myRange As Range, ByVal myColor As Long)
 Dim c As Range
 Dim cnt As Long

    For Each c In myRange
        If myColor = c.Interior.ColorIndex And _
           c.Value <> "" Then  '←空白以外のときの条件を追加
            cnt = cnt + 1
        End If
    Next

    ColorCount = cnt
 End Function

 ばっちりです!!
 思っていた通りのことができます。
 ありがとうございました。

コメント返信：

[ 一覧(最新更新順) ]

[[20040206172429]] 『色付きセルかつ空白でないセルを数えたい』（HIR） ページの最後に飛ぶ

[[20040206172429]]　『色付きセルかつ空白でないセルを数えたい』（HIR）　ページの最後に飛ぶ