Excel VBA質問箱 IV

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

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


6224 / 13644 ツリー ←次へ | 前へ→

【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 お礼[未読]

【46479】Do loop から抜け出せません
質問  初心者男  - 07/2/4(日) 23:08 -

引用なし
パスワード
   ExcelVBA初心者です。

質問ですが、Do loop Untilで条件が満たされてもループから抜け出しませんがどうしてでしょうか?

シートは以下のとおりです。

  A
-------
1|0.05
2|3.05
3|0

モジュールは以下のとおりです。

Sub kurikaesi()

Step = Range("A1").Value
Max = Range("A2").Value

Do
X = Range("A3").Value
Range("A3").Value = X + Step
Loop Until Range("A3").Value = Max + Step

End Sub

セルA3の値を0からStep(0.05)ずつ増加させ、セルA3の値がMax(3.05) + Step(0.05)=3.1に
なったら終了としたいのですが。不思議なことにループから抜け出しません。
セルA3は3.1となるのですがなぜでしょうか?

どなたかお分かりになる方いらっしゃいましたらどうかご教授願います。
当方の環境はWinXP+Excel2000です。

【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位程度なら、
結果を出してくれます。


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

【46521】Re:Do loop から抜け出せません
お礼  初心者男  - 07/2/5(月) 22:02 -

引用なし
パスワード
   ▼ichinose さん:
とても丁寧な解説ありがとうございました。
小数を扱う場合はシビアですね・・・
VBAはEXCELのワークシートに入力する感覚でやると痛い目にあいそうですね。
早速書き込んでいただいたプログラム解析してみます。

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

引用なし
パスワード
   ▼初心者男 さん:
こんばんは。

>VBAはEXCELのワークシートに入力する感覚でやると痛い目にあいそうですね。
いいえ、ワークシートだって小数は、要注意ですよ!!
補正をしているようなので0.05の62回の足し算では誤差がでませんが・・・。
そのメカニズムは、私にはわかりません。

有名な事例は、

適当なセルに

=0.5-0.4-0.1 と入力すれば、0になりますが、

=(0.5-0.4-0.1) と()を付けると -2.77556E-17となり、0にはならない。


又、
適当なセルに

=34.8-32.2 と入力し、
セル確定する前(Enterキーを押す前に)にF.9キーを押してください。

数式バーには、2.59999999999999 と表示されますよね?

補正をしているのでVBAのDoubleと同じように誤差はでませんが、
それでも上記のように誤差は出ています。

ですから、シートでも小数は要注意なんですよ!!

【46531】Re:Do loop から抜け出せません
お礼  初心者男  - 07/2/6(火) 0:36 -

引用なし
パスワード
   ▼ichinose さん:
お世話になります。
EXCELは永年使っているのですが、恥ずかしながら全然知らなかったです。
”循環小数”でググッてみたらいくつか解説されているサイトがあったので勉強してみます。

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