ＶＢ５での有効桁数以上の計算結果について。

質問

現在、VB5をやっているのですが、以前の質問のログを見てさらに思ったのですが、乗除算で
Double型で15桁や通貨型などで、有効桁数より大きな数（20桁）等を計算して、正しい数値を
表すには（指数ではなくて）何かいい方法があるのですか？
999,999,999,999,999 * 10 などの計算です。

回答No.2

TAGOSAKU7 · ベストアンサー

再度田吾作７です。

これを実行してみてください。

'バリアントで宣言
Dim wkDecimal As Variant
'１０進型でセット
wkDecimal = CDec(999999999999999# * 9999999#)
'イミディエイトウィンドウへ出力
Debug.Print wkDecimal

Dim の所でDecimal(10進型)で宣言したいところですが、それは出来ないようです。ですのでバリアント型で宣言しておき、値をセットするタイミングで１０進型にしてあげます。するとバリアントのwkDecimalは、内部で１０進型の変数になります。
偶然的に見つけたものですから、詳しく実験はしておりません。。。

でわでわ

回答No.1

TAGOSAKU7

どもども田吾作７です。

('_`)ウゥ 計算は標準で有効桁数が限られているので、標準では出来ないと思います。（もし出来るのであれば、ぼくも知りたいです。だれか教えて！）

ぼくの場合は自分で計算モジュールを作っちゃいます。

一応たし算とかけ算のサンプルを載せておきます。

そういえば、この前別の質問に答えて、サンプルを参考URLに載せたら、ｇｏｏの人から「直接リンクを張ってはいけない」とメールが送られてきて、しかもその発言を削除されてしまいました。。。(-ロ-;グハッ
どうやら、いけない行動だったらしいのです。ですので、ここにアドレスを書いときます。（ここならＯＫなのかな？）

http://f-ga.com/Lib/CalcProject.lzh
以下のソースは上記のファイルのソースを、コピペしたものです。

必要なコントロール
Command1
Text1
Text2
Label1

Command2
Text3
Text4
Label2

Private Sub Command1_Click()
'たし算
Dim wkStr As String
Dim wkLng As Long

With Me
'テキスト１には数値が長くても大丈夫
wkStr = .Text1.Text

'テキスト２にはLONG型に収まる値にしてください
wkLng = Val(.Text2.Text)

.Label1 = funcTASU(wkStr, wkLng)
End With
End Sub

Private Sub Command2_Click()
'かけ算
Dim wkStr As String
Dim wkLng As Long

With Me
'テキスト３には数値が長くても大丈夫
wkStr = .Text3.Text

'テキスト４にはLONG型に収まる値にしてください
wkLng = Val(.Text4.Text)

.Label2 = funcKAKERU(wkStr, wkLng)
End With
End Sub

Function funcTASU(inStrNumber As String, inLngPlusNumber) As String
Const CutNum As Long = 3 'とりあえず３桁で区切ることにする

Dim wkMaxLen As Long '文字型ナンバーの桁数
Dim wkMaxCnt As Long 'ループ回数
Dim wkMod As Long '３桁にならない余りの上位桁
Dim i As Long 'ループカウンタ
Dim wkSpotPos As Long '区切り位置

Dim wkSpotNum As Long '区切られた部分の数値

Dim wkCalc As Long '計算用ワーク

Dim memCalc As String '計算用ワーク
Dim ketaCalc As Long '桁上がり計算用ワーク

If Not IsNumeric(inStrNumber) Then GoTo PGMEND

wkMaxLen = Len(inStrNumber)
'この回数繰り返す
wkMaxCnt = (wkMaxLen \ CutNum)

'3で割り切れない桁数を得る
wkMod = (wkMaxLen Mod CutNum)

'余りがあるとき、ループ数を増やす
If Not (wkMod = 0) Then
wkMaxCnt = wkMaxCnt + 1
End If

For i = 1 To wkMaxCnt
'基本的に３桁づつ取り出す
If (i = wkMaxCnt) And (Not (wkMod = 0)) Then
'最上位桁が３桁じゃない時、上位余り桁を得る
wkSpotNum = Left(inStrNumber, wkMod)
Else
'それ以外
wkSpotPos = (wkMaxLen - (i * CutNum) + 1)
wkSpotNum = Mid(inStrNumber, wkSpotPos, CutNum)
End If

If i = 1 Then
'最下位桁には指定の値をたす
wkCalc = inLngPlusNumber + wkSpotNum
Else
'最下位桁以外は、繰り上がりの値をたす
wkCalc = wkSpotNum + ketaCalc
End If

'上位桁として下３桁だけ連結させる
memCalc = Right(wkCalc, CutNum) & memCalc

'１０の３乗で除算し、その答えが桁上がり
ketaCalc = wkCalc \ (10 ^ CutNum)
Next i

'桁上がりが存在していたら、上位桁として連結
If Not (ketaCalc = 0) Then
memCalc = ketaCalc & memCalc
End If

PGMEND:
'返り値をセット
funcTASU = memCalc
End Function

Function funcKAKERU(inStrNumber As String, inLngKakeruNumber) As String
Const CutNum As Long = 3 'とりあえず３桁で区切ることにする

Dim wkMaxLen As Long '文字型ナンバーの桁数
Dim wkMaxCnt As Long 'ループ回数
Dim wkMod As Long '３桁にならない余りの上位桁
Dim i As Long 'ループカウンタ
Dim wkSpotPos As Long '区切り位置

Dim wkSpotNum As Long '区切られた部分の数値

Dim wkCalc As Long '計算用ワーク

Dim memCalc As String '計算用ワーク
Dim ketaCalc As Long '桁上がり計算用ワーク

If Not IsNumeric(inStrNumber) Then GoTo PGMEND

wkMaxLen = Len(inStrNumber)
'この回数繰り返す
wkMaxCnt = (wkMaxLen \ CutNum)

'3で割り切れない桁数を得る
wkMod = (wkMaxLen Mod CutNum)

'余りがあるとき、ループ数を増やす
If Not (wkMod = 0) Then
wkMaxCnt = wkMaxCnt + 1
End If

For i = 1 To wkMaxCnt
'基本的に３桁づつ取り出す
If (i = wkMaxCnt) And (Not (wkMod = 0)) Then
'最上位桁が３桁じゃない時、上位余り桁を得る
wkSpotNum = Left(inStrNumber, wkMod)
Else
'それ以外
wkSpotPos = (wkMaxLen - (i * CutNum) + 1)
wkSpotNum = Mid(inStrNumber, wkSpotPos, CutNum)
End If

'とりあえずかける
wkCalc = inLngKakeruNumber * wkSpotNum

'繰り上がりの値をたす
wkCalc = wkCalc + ketaCalc

'上位桁として下３桁だけ連結させる
memCalc = Right(wkCalc, CutNum) & memCalc

'１０の３乗で除算し、その答えが桁上がり
ketaCalc = wkCalc \ (10 ^ CutNum)

Next i

'桁上がりが存在していたら、上位桁として連結
If Not (ketaCalc = 0) Then
memCalc = ketaCalc & memCalc
End If

PGMEND:
'返り値をセット
funcKAKERU = memCalc
End Function

ってな感じです。

でわでわ