| |
▼ジュン さん：
こんばんは。
>以前の問題と似ているのですが，新たな問題を課せられて困っています．
本当はね、前回のコードをじっくり見ていただいて理解していただくと
以下の問題のアルゴリズムはわかってくると思うのですが・・・。
>
>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）は、
アクティブシートのセルＡ１〜Ａ６に0,1,2,3,4,5と入力して下さい。
・Wi（1〜5）は、セルＢ２〜Ｂ６に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)」
という数式を指定して確認してみて下さい。
こういうの漸下式って言うんでしたっけ？
こういう式からループのアルゴリズムを書くのは良い練習問題になりますよ！！
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
