| |
こんばんは、皆さん。
>早速やってみましたが、これとはちょっと違うような・・・・・
>無限にでも計算出来る様な計算式（マクロ）が・・・・・・・・・
中学だったかな？高校１年生だったかな？
平方根の筆算（私のころは、縦書きの計算と呼んでいました）
を習ったことがありました。
意味もわからず、機械的に方法だけはマスターした記憶があります。
ありますが、これ使わないんですよね！！（試験にもでなかったし・・）
で調べると、
http://homepage1.nifty.com/moritake/sansu/6/heihoukon/PAGE001.HTM
バビロニアにおける平方根の求め方というらしいです。
'==================================
Sub main()
For idx = 1 To 10
Cells(idx, 1).Value = "'" & sqr_calc(idx, 100)
Next
End Sub
'=======================================================================
Function sqr_calc(myvalue As Variant, Optional lpmax As Long = 10) As string
'Input---myvalue---平方根
' lpmax-----計算回数
'out-----sqr_calc---myvalueの平方根
Dim wk As Double
Dim wk2 As Double
Dim ans As String
Dim vidx As Long
Dim jdx As Long
Dim nextketa As Long
Dim lpcnt As Long
Dim period As Boolean
period = False
wk = Int(CStr(myvalue))
Do Until wk < 100
wk = wk \ 100
Loop
vidx = Len(CStr(wk)) + 1
ans = ""
wk2 = 0
retcode = 0
lpcnt = 0
Do While retcode = 0 And lpcnt < lpmax
For jdx = 9 To 0 Step -1
If (wk2 * 10 + jdx) * jdx <= wk Then
wk = wk - (wk2 * 10 + jdx) * jdx
wk2 = CDbl(wk2) * 10 + jdx * 2
ans = ans & jdx
Exit For
End If
Next jdx
GoSub get_next_data
lpcnt = lpcnt + 1
Loop
sqr_calc = IIf(InStr(ans, ".") = Len(ans), Left(ans, Len(ans) - 1), ans)
Exit Function
get_next_data: '次の二桁を読み込む Input---wk, out---wk,ans(小数点をつけるときのみ）
nextketa = 0
Do While vidx <= Len(CStr(myvalue)) And nextketa < 2
If Mid(CStr(myvalue), vidx, 1) = "." Then
ans = ans & "."
period = True
Else
wk = wk * 10 + CDbl(Mid(CStr(myvalue), vidx, 1))
nextketa = nextketa + 1
End If
vidx = vidx + 1
Loop
If nextketa < 2 Then
If period = False Then
ans = ans & "."
period = True
End If
wk = wk * 10 ^ (2 - nextketa)
End If
If nextketa = 0 And CDbl(wk) = 0# Then
retcode = 1
Else
retcode = 0
End If
Return
End Function
もっとも計算回数が大きいと誤差も大きいと思いますけど・・・。
確認してみてください。
|
|
ichinose
- 05/12/26(月) 18:20 -
