Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

48712 / 76732

←次へ　｜　前へ→


	【32951】Re:マクロで平方根を・・・・・

アトラン

- 05/12/27(火) 23:58 -


	引用なし

	パスワード

▼ichinose さん：
>こんばんは、皆さん。
>>早速やってみましたが、これとはちょっと違うような・・・・・
>>無限にでも計算出来る様な計算式（マクロ）が・・・・・・・・・
>中学だったかな？高校１年生だったかな？
>平方根の筆算（私のころは、縦書きの計算と呼んでいました）
>を習ったことがありました。
>
>意味もわからず、機械的に方法だけはマスターした記憶があります。
>ありますが、これ使わないんですよね！！（試験にもでなかったし・・）
>で調べると、
>
>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
>
>もっとも計算回数が大きいと誤差も大きいと思いますけど・・・。
>確認してみてください。
これって、もしかしてC言語かな
DOSのコンパイラダウンロードから初めてみます。

0 hits

▼

【32873】マクロで平方根を・・・・・ Enzeru 05/12/26(月) 2:59