OFFICE VBA 関数 小数点を含む多数桁を足し算する関数 add calc over 15 degit include floating point

この関数の必要性

EXCELでは論文を書けない　計算が正しくないから
で述べたように15桁以上の計算はEXCELでは関数を作らないとできない。
今回は正の数の足し算を作ってみた。

配列を逆にする関数を使う

今回のプログラムはTipsfoundの配列を逆転させる関数を使います。
Call Reverseがそれでこれに関しては
VBA 配列の並びを反転させる
魚拓
を以下のVBAに追加してください。
原理的には
文字列として扱う数字１
文字列として扱う数字2
を小数点があるか、小数点があれば整数と少数のけたに分離し
小数点を足して
繰り上がりがあれば整数部に足しこむ
整数部分を計算する
結果を文字列で返す
という流れになります。

fnkasanmany.bas

Function fnKasanMany(str1, str2)
Dim Degi1, Degi2
Dim blPoint1, blPoint2, blCarry, blpoint
Dim Degi1F, Degi2F
Dim ar(), br(), arF(), brF()
Dim cr(), dr()
Dim iflPoint1, iflPoint2, blFloatCalc
Dim i, i1, i2, ia, ib, icarry, iflpoint
str1 = Replace(str1, ",", "", 1, -1)
str2 = Replace(str2, ",", "", 1, -1)
blPoint1 = False: blPoint2 = False: blFloatCalc = False
For i = 1 To Len(str1)
ReDim Preserve ar(1 To i)
If Mid(str1, i, 1) = "." Then blPoint1 = True: Degi1 = i - 1: Degi1F = Len(str1) - Degi1 - 1: iflPoint1 = i
ar(i) = Mid(str1, i, 1)
Next i
If blPoint1 = False Then Degi1 = Len(str2): Degi1F = 0
For i = 1 To Len(str2)
ReDim Preserve br(1 To i)
If Mid(str2, i, 1) = "." Then blPoint2 = True: Degi2 = i - 1: Degi2F = Len(str2) - Degi2 - 1: iflPoint2 = i
br(i) = Mid(str2, i, 1)
Next i
'小数点以下があるか、その最大桁数はいくつか
If blPoint1 = False Then Degi1 = Len(str1): Degi1F = 0
If blPoint2 = False Then Degi2 = Len(str2): Degi2F = 0
If blPoint1 = False And blPoint2 = False Then iflpoint = 0: blFloatCalc = False
If blPoint1 = False And blPoint2 = True Then iflpoint = Degi2F: blpoint = False: blFloatCalc = True
If blPoint1 = True And blPoint2 = False Then iflpoint = Degi1F: blpoint = True: blFloatCalc = True
If blPoint1 = True And blPoint2 = True Then
 If Degi1F >= Degi2F Then iflpoint = Degi1F: blpoint = True Else iflpoint = Degi2F: blpoint = False
 blFloatCalc = True
End If
ReDim Preserve cr(1 To iflpoint + 1)
'小数点以下を配列に格納
If blPoint1 = True Then
ReDim Preserve arF(1 To Degi1F)
For i = Degi1F To 1 Step -1
ia = UBound(ar)
ia = ia - i + 1
arF(i) = ar(ia)
Next
Call Reverse(arF)
End If
If blPoint2 = True Then
ReDim Preserve brF(1 To Degi2F)
For i = Degi2F To 1 Step -1
ib = UBound(br)
ib = ib - i + 1
brF(i) = br(ib)
Next
Call Reverse(brF)
End If
'小数点以下の計算
If blFloatCalc = True Then
blCarry = False
icarry = 0
For i1 = iflpoint To 0 Step -1
On Error Resume Next
ia = CLng(arF(i1))
If Err.Number <> 0 Then Err.Clear: ia = 0
ib = CLng(brF(i1))
If Err.Number <> 0 Then Err.Clear: ib = 0
If ia + ib + icarry >= 10 Then
cr(i1 + 1) = ia + ib + icarry - 10
blCarry = True
ElseIf ia + ib + icarry <= 10 Then
cr(i1 + 1) = ia + ib + icarry
blCarry = False
End If
If blCarry = True Then icarry = Fix((ia + ib + icarry) / 10) Else icarry = 0
Next
End If

Erase arF: Erase brF
ReDim Preserve arF(1 To Degi1)
ReDim Preserve brF(1 To Degi2)
For i1 = 1 To Degi1
arF(i1) = ar(i1)
Next
For i1 = 1 To Degi2
brF(i1) = br(i1)
Next
Call Reverse(brF): Call Reverse(arF)
iflpoint = 0
If Degi1 >= Degi2 Then iflpoint = Degi1 Else iflpoint = Degi2
icarry = 0
blCarry = False
ReDim Preserve dr(1 To iflpoint + 1)

For i1 = 1 To iflpoint + 1
On Error Resume Next
 If i1 = 1 Then
     icarry = cr(1)
     If Err.Number <> 0 Then icarry = 0
  End If
ia = CLng(arF(i1))
If Err.Number <> 0 Then Err.Clear: ia = 0
ib = CLng(brF(i1))
If Err.Number <> 0 Then Err.Clear: ib = 0
If ia + ib + icarry >= 10 Then
dr(i1) = CLng(Mid(CStr(ia + ib + icarry), 2, 1))
blCarry = True
ElseIf ia + ib + icarry <= 10 Then
dr(i1) = ia + ib + icarry
blCarry = False
End If
If blCarry = True Then icarry = Fix((ia + ib + icarry) / 10) Else icarry = 0
If i1 = iflpoint + 1 And blCarry = False Then dr(iflpoint + 1) = 0
Next
Stop
Call Reverse(dr)

For i1 = LBound(dr) To UBound(dr)
If i1 = 1 Then
 If dr(1) <> 0 Then
 fnKasanMany = CStr(dr(1))
 End If
Else
 fnKasanMany = fnKasanMany & CStr(dr(i1))
End If
Next
If blPoint1 = True Or blPoint2 = True Then
fnKasanMany = fnKasanMany & "."
For i1 = LBound(cr) + 1 To UBound(cr)
fnKasanMany = fnKasanMany & CStr(cr(i1))
Next
End If
Stop
End Function

高速化もなにもなし

これは一番最後の桁から1つづつ計算しているだけで、なんの工夫もありません。
その代わりこの関数はメモリが続く限り、小数点と整数が何桁であろうと確実に加算します。
数字にするから15桁の限界があるので、文字列にしてその限界を破っているわけです。
くどいようですが Please refer tipsfound about Reverse procedure