EXCELのマクロで数値比較

質問

「数量」「単価」「金額」のEXCELの表があり「金額」欄が「入力」であったり「計算式」であったりするため「金額」の不整合をチェックするマクロを作りました。（コードの一部は下記）
For cntR = 5 To MaxRow
If Cells(cntR, 8).Value <> _
Application.RoundDown(Cells(cntR, 6).Value * Cells(cntR, 7).Value, 0) Then
Cells(cntR, 23) = "計算違い"
End If
Next
計算違いとは思えないのに”計算違い”となってしまいます。
テストした表の内容
数量：200
単価：20、20.1、20.3・・・・・20.9、21
金額：=数量*単価の計算式が入っている。

マクロ実行後”計算違い”となってしまうケース。
単価：20.1と20.4の時
※金額に手入力してみる：”計算違い”になりません。
※金額欄の計算式を変えてみる=Rounddown(数量*単価,0)：”計算違い”になりません。

どこに問題があるのか特定できずにいます。
EXCEL2007・2000の両バージョン下でマクロに手を加えてます。

回答No.2

Wendy02 · ベストアンサー

こんにちは。

どうも最近、あまり脱線して書くことはできないようですが、ワークシートには、独特の誤差修正が施されていますが、完全には駆逐できていません。せめて、0.1%以下程度にしてくれればとは思いますが、これは、Microsoft 側の開発側の問題で、IEEE 754 の Double 型をそのまま使用していることが原因です。決して、Microsoft 側の言う、IEEE 754（電子規格）だけの問題ではないと思うのです。

http://support.microsoft.com/kb/78113/ja
Excel で浮動小数点演算の結果が正しくない場合がある

しかし、その反面、VBA側は、Double型の約半分ぐらいが、そのままの丸め誤差が発生します。それを、どう処理するかであって、一般のユーザーは、その原因を細かく追究しても始まりません。

Cells(cntR, 6).Value
Cells(cntR, 7).Value
どちらかは分かりませんが、小数点のあるほうは、そのまま、ダイレクトで代入できません。

曲がりなりにもワークシート側で処理されたものと、VBAでの小数点の演算を、そのまま比較するということは出来ません。ワークシートでは、小数点の掛け算自体には、それほどに誤差が発生していないはずです。

VBA(VB6のマニュアルに出てくる）では、浮動小数点誤差対策としては、小数点固定法というものと、整数変換法という方法があります。

今回は、10倍という方法で比較するなら、これは、整数変換法ということにはなるとは思いますが、それを、10で割ってやっても誤差は出ないはずです。

= 単価 * 数量
　↑
VBAでは、ここがDouble型になります。

If (Cells(cntR, 8).Value <> _
(Cells(cntR, 6).Value * Cells(cntR, 7).Value, 0 * 10)/10 Then

通常は、このように、Currency型に変換する方法が使います。
ただし、ワークシート側には、今回は、小数点の誤差は出ていないことを前提としています。（ワークシートには、引き算、割り算でも必ず誤差が出ます）
'-------------------------------------------
'
Dim cntR As Long
Dim MaxRow As Long
MaxRow = Range("H65536").End(xlUp).Row
　　For cntR = 5 To MaxRow
　　If Cells(cntR, 8).Value <> _
　　　　CCur(Cells(cntR, 6).Value * Cells(cntR, 7).Value) Then
　　　　 Cells(cntR, 23).Value = "計算違い"
　　End If
　Next
End Sub

お礼

質問は締めきりますが、貴重な勉強をさせていただき感謝します。
まだまだ初心者ではありますが、今後に必ず役立つものと思います。

回答No.1

FEX2053

こいつが原因かもですね。
http://pc.nikkeibp.co.jp/pc21/special/gosa/eg1.shtml

RoundDownするってことは、.999999を切り捨てるってことなので。
小数があるなら、一旦整数化して計算するなりしないと。

お礼

下記コードのように修正し解決できました。
ありがとうございました。
If Application.RoundUp(Cells(cntR, 8).Value * 10,0) <> _
Application.RoundDown(Cells(cntR, 6).Value * Cells(cntR, 7).Value, 0) * 10 Then
Cells(cntR, 23) = "計算違い"
End If