Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


35450 / 76732 ←次へ | 前へ→

【46481】Re:Do loop から抜け出せません
発言  ichinose  - 07/2/5(月) 8:04 -

引用なし
パスワード
   ▼初心者男 さん:
おはようございます。
非常にわかりやすい記述です。
こういう記述を続けていけば、きっとVBAの上達は速いと思いますよ!!

さて、本題ですが、小数を扱う時は要注意という典型例です。

もうちょっと簡単にしましょう!!


Sub kurikaesi()
  Dim ans As Double
  Dim step As Double
  Dim max As Double
  Dim x As Double
  step = 0.05
  max = 3.05
  ans = step + max
  x = 0
  Do
    x = x + step
    Loop Until x = ans
  MsgBox x
End Sub

これでもループを抜け出せないことを確認してください。
つまり、変数 xとans 等しくならない ということです。

理由は、小数が10進では確定された数値でも二進数に直すと循環小数になってしまう
場合があるからです。
MS社でも工夫しているようですが、この誤差を埋めることは出来ていません。

改めて新規ブックの標準モジュールに

'================================================================
Option Explicit

Sub kurikaesi()
  Dim ans As Double
  Dim step As Double
  Dim max As Double
  Dim x As Double
  Dim cnt As Long
  Dim ans_hex As String
  Dim x_hex As String
  step = 0.05
  max = 3.05
  ans = step + max
  x = 0
  Do
    x = x + step
    cnt = cnt + 1
    If cnt = 62 Then Exit Do
    Loop Until x = ans
  MsgBox "ans=" & ans & vbCrLf & _
      "x=" & x
  MsgBox "ans = x ----- " & (ans = x)
  ans_hex = floating_point(ans, 1)
  x_hex = floating_point(x, 1)
  MsgBox "ansの内部データ " & ans_hex & vbCrLf & _
      "xの内部データ " & x_hex
End Sub
'=====================================================================
Function floating_point(ByVal myvalue As Variant, ByVal typ As Long) As String
'指定された型の数値のメモリーイメージをHEXコードで出力する
'in ----myvalue----数値
'  typ=0--single 1--double 2----currency
'out-----floating_Point ---メモリーイメージ(HEXコードで)
  On Error Resume Next
  Const typ_sin = 0
  Const typ_dbl = 1
  Const typ_cur = 2
  Const flnm = "\binary.tmp"
  Dim dbb(0 To 7) As Byte
  Dim sbb(0 To 3) As Byte
  Dim idx As Long
  Dim mes As String
  Dim dd As Double
  Dim ss As Single
  Dim cc As Currency
  Dim fnum As Long
  Dim wk As String
  Select Case typ
   Case typ_sin
    ss = CSng(myvalue)
   Case typ_dbl
    dd = CDbl(myvalue)
   Case typ_cur
    cc = CCur(myvalue)
   End Select
  Kill ThisWorkbook.Path & flnm
  On Error GoTo 0
  fnum = FreeFile()
  Open ThisWorkbook.Path & flnm For Random As #fnum Len = IIf(typ = typ_sin, UBound(sbb()) + 1, UBound(dbb()) + 1)
  Select Case typ
   Case typ_sin
    Put #fnum, , ss
    Get #fnum, 1, sbb()
   Case typ_dbl
    Put #fnum, , dd
    Get #fnum, 1, dbb()
   Case typ_cur
    Put #fnum, , cc
    Get #fnum, 1, dbb()
   End Select
  Close #fnum
  Kill ThisWorkbook.Path & flnm
  floating_point = ""
  For idx = IIf(typ = typ_sin, UBound(sbb()), UBound(dbb())) To 0 Step -1
    If typ = typ_sin Then
     wk = Hex(sbb(idx))
     If Len(wk) = 1 Then wk = "0" & wk
     floating_point = floating_point & wk
    Else
     wk = Hex(dbb(idx))
     If Len(wk) = 1 Then wk = "0" & wk
     floating_point = floating_point & wk
     End If
    Next
  Erase sbb(), dbb()
End Function


** 一度、ブックを保存した後、kurikaesi を実行してください。 **

計算では、ループを62回繰り返せば、

Xは3.1 ansの3.1と同じになる 事を想定していますよね?


よって、上記のコードは62回のループを数えて繰り返しを抜けています。

実行してx とansの結果を比べてください

見た目の表示は 確かに3.1で同じですが、

x=ans は、決してTrueになりません。

ansと xは、倍精度浮動小数点型(8バイトデータ)ですから、
その内部形式まで調べてみると・・・、

やっと、微妙な桁数で違いが見られます。

この違いが本来なら抜けるはずのループ処理を
無限ループにしています。


でどのようにするかは、何が目的のコードなのかをお聞きしなくては
なりませんが、一例として

'========================================
Sub kurikaesi3()
  Dim ans As Currency
  Dim step As Currency
  Dim max As Currency
  Dim x As Currency
  step = 0.05
  max = 3.05
  ans = step + max
  x = 0
  Do
    x = x + step
    Loop Until x = ans
  MsgBox x
End Sub

というように固定小数点型のデータを使うと小数第2位程度なら、
結果を出してくれます。


繰り返しますが、小数を扱う場合は、要注意ですよ!!

3 hits

【46479】Do loop から抜け出せません 初心者男 07/2/4(日) 23:08 質問
【46481】Re:Do loop から抜け出せません ichinose 07/2/5(月) 8:04 発言
【46521】Re:Do loop から抜け出せません 初心者男 07/2/5(月) 22:02 お礼
【46522】Re:Do loop から抜け出せません ichinose 07/2/5(月) 22:45 発言
【46531】Re:Do loop から抜け出せません 初心者男 07/2/6(火) 0:36 お礼

35450 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free