検証
新規Word文書を作成し、次のコードを実行します。
最初はDefaultの200,000円で実行してください
Excelを使うのでちょっと遅いです。
Sub Wordの演算誤差のSample1()
Dim wDoc As Word.Document: Set wDoc = ThisDocument
Dim varCur As Currency, varCurEx As Currency, varCurTax As Currency
Selection.WholeStory
varCur = InputBox("税込み金額(円単位、最大15桁までの正の整数)を入力してください", "税込み金額を入力", "200000")
On Error Resume Next
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=wDoc.Characters.Count
On Error GoTo 0
wDoc.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Selection.Tables(1)
'If .Style <> "Table (lattice)" Then
'.Style = "Table (lattice)"
'End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
With Selection
.TypeText Text:=CStr(varCur)
.ParagraphFormat.Alignment = wdAlignParagraphRight
.MoveRight Unit:=wdCharacter, Count:=1
.Fields.Add Range:=.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
.TypeText Text:="=INT(A1/1.1)"
.ParagraphFormat.Alignment = wdAlignParagraphRight
.MoveRight Unit:=wdCharacter, Count:=1
.MoveRight Unit:=wdCell, Count:=1
.Fields.Add Range:=.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
.TypeText Text:="=A1-B1"
.ParagraphFormat.Alignment = wdAlignParagraphRight
End With
wDoc.Fields.Update
varCur = Replace(wDoc.Range.Tables(1).Cell(1, 1).Range.Text, Chr(13) & Chr(7), "", 1, -1, vbTextCompare)
varCurEx = Replace(wDoc.Range.Tables(1).Cell(1, 2).Range.Text, Chr(13) & Chr(7), "", 1, -1, vbTextCompare)
varCurTax = Replace(wDoc.Range.Tables(1).Cell(1, 3).Range.Text, Chr(13) & Chr(7), "", 1, -1, vbTextCompare)
With CreateObject("Excel.Application")
MsgBox ("The tax-included price of " & .Text(varCur, "#,#00") & " yen was divided by 1.1 to obtain the tax-excluded price. Fractions are rounded down to the nearest yen." & vbCrLf & "税込み価格" & .Evaluate("NUMBERSTRING(" & CStr(varCur) & ", 1)") & "を1.1で割り,端数を切り捨てました。税額" & .Evaluate("NUMBERSTRING(" & CStr(varCurTax) & ", 1)") & "円は、税込み価格から本体価格を控除しました")
End With
End Sub
実行結果
200000 181818 18182
こんな感じになります。
演算誤差が発生してWordは金額を間違う
次に再度マクロを実行し、220,000を入力します。
現在の消費税は10%です。
税込価格は本体価格に10%加算、つまり1.1倍しています。
このため1.1で割れば200,000です。
実行結果は完全に間違い
結果は
220000 199999 20001
税額は20,000です。
これはなにかの間違いでしょうか。
3桁の計算すらできない
それでは110ではどうでしょう。
税抜は100円です。税額は10円です。
110 99 11
INTは円未満を基本切り捨てるだけなので影響しないです。
つまり演算誤差が発生してまともに計算ができないわけです。
とくに複雑な計算はしていません。たんなる掛け算です。
それすらWordはできないのです。
演算誤差の解消
税込価格から税抜価格を求めるときは必ずRoundを使う
この演算誤差の解消の鍵はB1セルです。
そこ以外は引き算なので。税込価格から税抜価格、本体価格を求めるには必ずRoundを使います。
そうしない限りまともに計算できないのです。何ということでしょう。電卓以下です。
{ = ROUND(A1/1.1,0) }
この原因はパソコンは近似十進計算で小数点以下はほぼでたらめであるというとんでもない法則があるためです。
ここまであっさり出るのは珍しいですが。
美少女微小値を足す方法
大体10億まで計算するとします。
なので、INTを使いつつ、10億分くらい0をつけた数を足します。
今回は正の整数限定なので、これで解消できます。
=INT(A1+0.00000000001)
なぜかと言うと、本来、税込価格から税額を出すのが先であり、税額は円未満切捨てだからです。
そのときに、Roundを使うのは切捨てなのにおかしいじゃないかということになります。
表示形式で四捨五入する方法
AccessとWordで顕著ですが、表示形式で四捨五入ができます。
=A1/1.1 \#"#,0"
ここでExcelのような#,##0
ではないことに注意してください。#は数字がないときは空白が返ります。なるべく空白を返さないためには#は一つしかつかわない方がいいのです。
税込価格から消費税額を計算するフィールドコード
ところでA1とか言っていますが、Wordの場合、Excelと同じく一番左上がA1です。列はA,B,C。行は1,2,3です。
A1に税込価格が入ったので計算します。
ところで、消費税額の計算は本来は本体価格、つまり税抜価格に税額をかけて計算します。
なので、税込価格から税額を計算するのは本来の計算方法ではないことを念頭に置いてください。
基本的に切捨て計算ですので、微小値を足して切捨て、これに符号をかけて、書式を整えます。
本体価格は税込価格から税額を控除して求めます。
B1 A1-C1
C1 =INT((ABS(A1)-(ABS(A1)/1.1) )+0.0000001)*SIGN(A1) \#"#,0"
200000 181,819 18,181
181,819を1.1倍します
200,000.9となり、概ね正しい結果が得られます。
最初はどうかと言うと
200000 181818 18182
181,819より1少ないです。これを1.1倍すると
199,999.8となります。
切捨てると失敗します。
一桁多い2,000,000円では
2,000,000円 1,818,181 181,819
となり
1,818,181を1.1倍すると
1,999.999.1となり、四捨五入でも失敗します。
つまり税額から先に求めた方がいいわけです。
これを正確に証明したいのですが、演算誤差とミックスするため難しいです。
Sub Word_SalesTaxWithoutCaluculateAccuracy()
' Word日本語版を推奨
' 消費税(10%)を含んだ価格から、税額、税抜本体価格を求めます。
Dim wDoc As Word.Document: Set wDoc = ThisDocument
Dim varCur As Currency, varCurEx As Currency, varCurTax As Currency
Selection.WholeStory
varCur = InputBox("税込み金額(円単位、最大15桁までの正の整数)を入力してください", "税込み金額を入力", "200000")
On Error Resume Next
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=wDoc.Characters.Count
On Error GoTo 0
wDoc.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Selection.Tables(1)
'If .Style <> "Table (lattice)" Then
'.Style = "Table (lattice)"
'End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
With Selection
.TypeText Text:=CStr(varCur)
.ParagraphFormat.Alignment = wdAlignParagraphRight
.MoveRight Unit:=wdCharacter, Count:=1
.Fields.Add Range:=.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
.TypeText Text:="=(ABS(A1)-ABS(C1))*SIGN(A1) \#""#,0"""
.ParagraphFormat.Alignment = wdAlignParagraphRight
.MoveRight Unit:=wdCharacter, Count:=1
.MoveRight Unit:=wdCell, Count:=1
.Fields.Add Range:=.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
.TypeText Text:="=INT((ABS(A1)-(ABS(A1)/1.1) )+0.0000001)*SIGN(A1) \#""#,0"""
.ParagraphFormat.Alignment = wdAlignParagraphRight
End With
wDoc.Fields.Update: DoEvents
wDoc.Fields.Update: DoEvents '更新されないことがあるので、1度多く再計算している
varCur = Replace(wDoc.Range.Tables(1).Cell(1, 1).Range.Text, Chr(13) & Chr(7), "", 1, -1, vbTextCompare)
varCurEx = Replace(wDoc.Range.Tables(1).Cell(1, 2).Range.Text, Chr(13) & Chr(7), "", 1, -1, vbTextCompare)
varCurTax = Replace(wDoc.Range.Tables(1).Cell(1, 3).Range.Text, Chr(13) & Chr(7), "", 1, -1, vbTextCompare)
With CreateObject("Excel.Application")
MsgBox ("The tax-included price of " & .Text(varCur, "#,#00") & " yen was divided by 1.1 to obtain the tax-excluded price. Fractions are rounded down to the nearest yen." & vbCrLf & "税込み価格" & .Evaluate("NUMBERSTRING(" & CStr(varCur) & ", 1)") & "を1.1で割り,端数を切り捨てました。税額" & .Evaluate("NUMBERSTRING(" & CStr(varCurTax) & ", 1)") & "円は、税込み価格から本体価格を控除しました")
End With
End Sub
業務用はさらに複雑です
消費税の端数処理は切り捨て?切り上げ?消費税改正後の対応とは
これでいくと
- 本体価格を10%、8%に分けて合計する。
- それぞれに税率をかけて、円未満で切り捨てる
- この端数処理は1請求書につき税率ごとに1回しか行ってはならない。
- 税込価格をもとめて合計する
この場合は縦に計算する必要があります。
こうした表のフィールドコードはVBAが使えますが、IFフィールドの入力が難しいです。また税率列を含んで右側の列は不可視にできるといいと思います。
品名 | 本体価格 | 税率 | 8 | 10 |
---|---|---|---|---|
食品 | 1000 | 8 | 1000 | |
鉛筆 | 2000 | 10 | 2000 | |
コーヒー(イートイン) | 5000 | 10 | 5000 | |
税別計 | 1000 | 7000 | ||
10%対象 | 7000 | 税額 | 700 | |
8%対象 | 1000 | 税額 | 80 | |
本体価格計 | 8000 | |||
消費税相当額 | 780 | |||
税込み価格 | 8780 |
ちなみに、これをちまちまと打っているのですが、Cannonの電卓で打っています。Casioより好きではありませんが、ExcelやWordよりはるかに役立ちます。生産性が格段に違います。Wordはエラーばかりです。
https://qiita.com/mjusui/items/166159398a588308bb3a
なぜIT化が進まないのかは簡単です。まずまともに算数すらできないからです。電卓以下の性能を改善しましょう。電卓より劣るのに電卓より高い。そんな製品やサービスを導入する必要はないでしょう。
参考文献
Docs Office VBA リファレンス Word 概念 Word の操作 テーブルの操作
消費税の端数処理は切り捨て?切り上げ?消費税改正後の対応とは
VBAで数値を漢数字に変換する方法
数値を漢数字にする−NUMBERSTRING関数 relief 2004/1/1
Word2010:IFフィールドの使い方
ワードVBAの質問です。