Excel VBA質問箱 IV

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

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


62738 / 76732 ←次へ | 前へ→

【18595】Re:数値計算についての質問3
発言  ichinose  - 04/9/30(木) 21:09 -

引用なし
パスワード
   ▼ジュン さん:
こんばんは。

>以前の問題と似ているのですが,新たな問題を課せられて困っています.
本当はね、前回のコードをじっくり見ていただいて理解していただくと
以下の問題のアルゴリズムはわかってくると思うのですが・・・。


>
>Tn=A*Pn+B*((Σ(i=1⇒n)Wi×Pn-i)-(Σ(i=1⇒n)Wi×Tn-i)) 
>という数値計算を行いたいとき,
>A=B=定数
>T0=P0=0
>Pn:=nのときの値(既知)
>Wi:i=1〜nのときの値(既知)
>が与えられたときのTnの値を求めたいのですが,
>
>例えば,
>A=10
>B=20
>n=5
>Pn=1,2,3,4,5 (n=1〜5)
>Wi=0.2,0.4,0.6,0.8,1.0 (i=1〜5)

例題として、

・P0及び、Pn(1〜5)は、
 アクティブシートのセルA1〜A6に0,1,2,3,4,5と入力して下さい。
・Wi(1〜5)は、セルB2〜B6に0.2,0.4,0.6,0.8,1と入力して下さい。


コードは、以下のとおりです。前回のコードとは違うコードも記述されていますが、
もっうちょっと使いやすくした結果です。

'===============================================================
Sub test()
  MsgBox newtn(5, 0, Range("a1:a6"), Range("b2:b6"), 10, 20)
End Sub
'===========================================================
Function newtn(n As Long, t0 As Variant, _
             p_rng As Range, _
             w_rng As Range, _
             a As Variant, _
             b As Variant)
'newTn=A*Pn+B*((Σ(i=1⇒n)Wi×Pn-i)-(Σ(i=1⇒n)Wi×Tn-i))を計算する
'input : n 求めたい数列値、t0--初期値
'    p_rng p0〜pnに相当するセル範囲
'    w_rng w1〜wnに相当するセル範囲
'    a 、b 定数
'output: newtn 結果
  Dim idx As Long
  Dim jdx As Long
  Dim pn() As Variant
  Dim wn() As Variant
  Dim Swixpnm1 As Variant
  Dim Swixtnm1 As Variant
  ReDim ans(n) As Variant
'この'***********で挟んである間のコードはあまり気にしないでよいです
'ただ、指定されたセル範囲データの配列変数にセットしなおしているだけです
'************************************************************
  With p_rng
   If .Rows.Count > 1 Then
     ReDim pn(.Rows.Count)
     For idx = 1 To .Rows.Count
      pn(idx - 1) = CDec(.Cells(idx, 1).Value)
      Next idx
   ElseIf .Columns.Count > 1 Then
     ReDim pn(.Columns.Count)
     For idx = 1 To .Columns.Count
      pn(idx - 1) = CDec(.Cells(1, idx).Value)
      Next idx
   Else
     ReDim pn(0)
     pn(0) = CDec(Cells(1, 1).Value)
     End If
   End With
  With w_rng
   If .Rows.Count > 1 Then
     ReDim wn(1 To .Rows.Count)
     For idx = 1 To .Rows.Count
      wn(idx) = CDec(.Cells(idx, 1).Value)
      Next idx
   ElseIf .Columns.Count > 1 Then
     ReDim wn(1 To .Columns.Count)
     For idx = 1 To .Columns.Count
      wn(idx) = CDec(.Cells(1, idx).Value)
      Next idx
   Else
     ReDim wn(0)
     wn(0) = CDec(Cells(1, 1).Value)
     End If
   End With
'***********************************************************
'問題解決のコードはここからです
'
  ans(0) = CDec(t0)
  For idx = 1 To n
   Swixpnm1 = 0
   Swixtnm1 = 0
   For jdx = idx - 1 To 0 Step -1
    Swixpnm1 = Swixpnm1 + wn(idx - jdx) * pn(jdx)
    Swixtnm1 = Swixtnm1 + wn(idx - jdx) * ans(jdx)
    Next
   ans(idx) = CDec(a) * pn(idx) + CDec(b) * (Swixpnm1 - Swixtnm1)
   Next
  newtn = ans(UBound(ans()))
End Function


Cdec関数というのが出てきていますが、小数計算の小さい誤差がでないように
使いました(これは、前回のコードにも入れたほうがよさそうです)
アルゴリズムの基本的なところは変わっていません。

上記の「newtn」は、ワークシート関数としても使えます。

例えば、セルC6に「=newtn(5,0,$A$1:$A$6,$B$2:$B$6,10,20)」
という数式を指定して確認してみて下さい。

こういうの漸下式って言うんでしたっけ?
こういう式からループのアルゴリズムを書くのは良い練習問題になりますよ!!

0 hits

【18561】数値計算について ジュン 04/9/29(水) 16:55 質問
【18563】Re:数値計算について ichinose 04/9/29(水) 19:11 回答
【18570】Re:数値計算について(一箇所訂正) ichinose 04/9/29(水) 22:39 発言
【18573】Re:数値計算について ジュン 04/9/29(水) 23:10 お礼
【18577】Re:数値計算についての質問2 ジュン 04/9/30(木) 2:19 質問
【18579】Re:数値計算についての質問2 ichinose 04/9/30(木) 7:39 発言
【18582】Re:数値計算についての質問2 ジュン 04/9/30(木) 8:47 お礼
【18587】数値計算についての質問3 ジュン 04/9/30(木) 15:09 質問
【18595】Re:数値計算についての質問3 ichinose 04/9/30(木) 21:09 発言
【18644】Re:数値計算についての質問3 ジュン 04/10/2(土) 21:11 お礼

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