ＥＸＣＥＬ ＦＣＳ関数の質問です

質問

ＥＸＣＥＬ２００３です。下記ＶＢＡを標準モデュールに貼り付けた上でＦＣＳ関数を使用してみましたがうまく動作しません。数字の色が赤の時は合計ができますが、その他の色の時は合計があいません。また色を変更しても計算ができません。どのようにすると計算するのか教えて下さい。Σの計算のように計算したいセルに式をいれておけば、いつでも計算するようには使用できない関数でしょうか。よろしくお願いします。
Function FCS(adrs,clr)
sm=0
For Each and ln adrs
Fci=ad.Font.Colorindex
Cv=ad.Value
If fci=clr Then
Sm=sm+cv
End lf
Next
FCS=sm
End Function

回答No.2

Wendy02 · ベストアンサー

質問で掲示したコードは、手で書き写したものでしょうから、だいぶ、雑になっているようです。少し手を加え工夫をしました。Adrs は、セル範囲ですが、clr は、数字もしくはセルで、フォントに色を付けた同じものを探します。また、Optional にしていますから、引数のclr を抜きにしますと、ワークシート関数のSUM と同じになります。

=FCS(A1:A20,C1)　C1 に文字や数字を入れて、Fontに色を付ける

なお、色を変更するだけでは、関数は基本的には再計算されません。それを実現するには、複雑なマクロが必要になります。また、F9(または、Shift + F9)を押しても、そのままでは、計算しませんので、再計算をさせるには、以下のように、Application.Volatile を入れますが、実務では、そうせずに、引数の値を変えたり、数式にEnter を入れるだけで、再計算させます。あまり大した効果が得られないからです。

'//
Function FCS(Adrs As Range, Optional clr As Variant)
　Dim dSm As Double, cv As Double
　Dim fci As Integer, ad As Variant
　'Application.Volatile　　'これを外せば再計算します。
　If TypeName(clr) = "Range" Then
　　clr = clr.Font.ColorIndex
　End If
　dSm = 0
　If IsMissing(clr) = False Then
　　For Each ad In Adrs
　　　fci = ad.Font.ColorIndex
　　　cv = Val(ad.Value)
　　　If fci = clr Then
　　　　dSm = dSm + cv
　　　End If
　　Next
　Else
　　dSm = Application.Sum(Adrs)
　End If
　FCS = dSm
End Function

お礼

丁寧なコードを記載していただき誠にありがとうございました。詳細な説明で助かりました。

回答No.1

kmetu

あいますよ

フォントの色で「標準」のIndex番号は-4105になりますが、黒だから1で試していませんか？

また、文字の色を変えても再計算はされないので関数は実行されませんのでF9などを押して再計算させてください。

お礼

早速の回答ありがとうございました。