[[20180621190059]]　『色の付いたセルをリアルタイムにカウントしたい。』（トランプ）　ページの最後に飛ぶ

『色の付いたセルをリアルタイムにカウントしたい。』（トランプ）

お尋ねいたします。
色の付いたセルの数を色別にカウントするシートをネット等の情報を参考につくってみました。
見事にカウントはできるのですが、できれば、リアルタイムにカウントするようにしたいのです。また、それが難しいのであれば、マクロボタンを作って、それを押すと、情報が更新されて最新のカウント数が表示されるようにしたいのですが、ご教授願います。よろしくお願いします。

以下のような関数をB5、C5セルに設定。
B5=IFERROR(colorcount($C$9:$K$24,$B$4),0)
C5=IFERROR(colorcount($C$9:$K$24,$C$4),0)

以下のようなマクロを設定。
Function ColorCount(R1 As Range, C As Range)

    Dim r As Range

    Application.Volatile
    ColorCount = 0

    For Each r In R1
        If r.Interior.Color = C.Interior.Color Then
            ColorCount = ColorCount + 1
        End If
    Next r

End Function

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

https://www.moug.net/tech/exvba/0100006.html

↑これを試したらどうでしょう？

（まっつわん） 2018/06/21(木) 20:03

すみません。
これをどのように導入すればよいでしょうか・・・
（トランプ） 2018/06/21(木) 20:35

あぁ、もう書いてあるんですね。。。失礼しました。

試したらリアルタイムで更新されます。

もしかして条件付き書式設定で設定された塗りつぶしが対象ですか？

（まっつわん） 2018/06/21(木) 20:49

 リアルタイムって、セルの色を変えたらってこと？
 どうやって色を変えているのか知らんけど無理っぽい気がする。
 単にＦ９を押せばいいんじゃないですか？
（BJ） 2018/06/21(木) 20:52

セルに直接色つけしてます。
リアルタイムは無理なんですかね。
（トランプ） 2018/06/21(木) 20:55

 色を変えた時のイベントが用意されて無いので、四六時中監視するプログラムを自分で作るとか・・。
 自分で色選択ボタンを押したときのイベントを作るのもいいだろうけど、
 2007以降のJavaボタン？の操作知らないし。

 Ｆ９キーでも良いとは思うんだけど・・・。

 大雑把にセルの移動イベントで、

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Worksheets(1).Calculate         '適切なシートにかえる。
 End Sub
（BJ） 2018/06/21(木) 21:16

BJさんのイベントを試みましたが、
やはり、リアルタイムとはいきませんでした。
（トランプ） 2018/06/21(木) 22:54

 うん、いかないよ。
 自分でイベント作って無いし、Javaのボタンのイベント作り方知らないし。
 だから、単純にアクティブセルの移動にしてみただけ。
（BJ） 2018/06/21(木) 23:13

ありがとうございます。
F9キーで更新させたいと思います。
（トランプ） 2018/06/22(金) 07:13

同じようなのがあったよ。
https://oshiete.goo.ne.jp/qa/4680287.html
（通りすがり） 2018/06/22(金) 08:52

利用には注意が必要ですが、強引に実現するならこんな方法があります。

下記の構文ではAutoCalcOn()を実行して以降、OnTimeで0.5秒おきに再計算を実施しています。
AutoCalcOff()を実行したら次の再計算を最後に監視を終了します。

Private AutoCalcFlag As Boolean

Sub AutoCalc()

    Static LastAdr As String
    Static LastClr As Long
    If AutoCalcFlag Then Application.OnTime [Now() + "00:00:00.5"], "AutoCalc"
    If TypeName(Selection) <> "Range" Then Exit Sub

    If LastAdr = Selection.Address Then
        If LastClr <> Selection.Interior.Color Then
            Application.Calculate
        End If
    End If
    LastAdr = Selection.Address
    LastClr = Selection.Interior.Color
End Sub

Sub AutoCalcOn()

    AutoCalcFlag = True
    Call AutoCalc
End Sub

Sub AutoCalcOff()

    AutoCalcFlag = False
End Sub
（名無し） 2018/06/22(金) 09:07

コメント返信：

[ 一覧(最新更新順) ]

[[20180621190059]] 『色の付いたセルをリアルタイムにカウントしたい。』（トランプ） ページの最後に飛ぶ

[[20180621190059]]　『色の付いたセルをリアルタイムにカウントしたい。』（トランプ）　ページの最後に飛ぶ