Excel VBA質問箱 IV

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

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


48761 / 76732 ←次へ | 前へ→

【32902】Re:マクロで平方根を・・・・・
発言  ichinose  - 05/12/26(月) 18:20 -

引用なし
パスワード
   こんばんは、皆さん。
>早速やってみましたが、これとはちょっと違うような・・・・・
>無限にでも計算出来る様な計算式(マクロ)が・・・・・・・・・
中学だったかな?高校1年生だったかな?
平方根の筆算(私のころは、縦書きの計算と呼んでいました)
を習ったことがありました。

意味もわからず、機械的に方法だけはマスターした記憶があります。
ありますが、これ使わないんですよね!!(試験にもでなかったし・・)
で調べると、

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

もっとも計算回数が大きいと誤差も大きいと思いますけど・・・。
確認してみてください。

0 hits

【32873】マクロで平方根を・・・・・ Enzeru 05/12/26(月) 2:59 質問
【32874】Re:マクロで平方根を・・・・・ やっちん 05/12/26(月) 3:53 回答
【32875】Re:マクロで平方根を・・・・・ アトラン 05/12/26(月) 5:06 お礼
【32876】Re:マクロで平方根を・・・・・ アトラン 05/12/26(月) 5:20 発言
【32877】Re:マクロで平方根を・・・・・ やっちん 05/12/26(月) 5:43 発言
【32878】Re:マクロで平方根を・・・・・ やっちん 05/12/26(月) 8:37 発言
【32950】Re:マクロで平方根を・・・・・ アトラン 05/12/27(火) 23:56 回答
【32973】Re:マクロで平方根を・・・・・ やっちん 05/12/28(水) 12:31 発言
【32953】Re:マクロで平方根を・・・・・ アトラン 05/12/28(水) 0:01 回答
【32954】Re:マクロで平方根を・・・・・ アトラン 05/12/28(水) 0:03 回答
【32956】Re:マクロで平方根を・・・・・ 何様? 05/12/28(水) 1:11 質問
【32902】Re:マクロで平方根を・・・・・ ichinose 05/12/26(月) 18:20 発言
【32951】Re:マクロで平方根を・・・・・ アトラン 05/12/27(火) 23:58 回答
【33002】Re:マクロで平方根を・・・・・ ichinose 05/12/28(水) 17:36 発言
【33007】Re:マクロで平方根を・・・・・ ni 05/12/29(木) 0:01 発言
【32880】Re:マクロで平方根を・・・・・ Kein 05/12/26(月) 12:52 発言
【32881】Re:マクロで平方根を・・・・・ やっちん 05/12/26(月) 13:03 発言
【32952】Re:マクロで平方根を・・・・・ アトラン 05/12/28(水) 0:00 回答
【32980】Re:マクロで平方根を・・・・・ Kein 05/12/28(水) 13:35 発言
【32984】Re:マクロで平方根を・・・・・ A 05/12/28(水) 14:40 発言

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