基準が変わっていく繰り返し計算

質問

以下の表のように、任意の数に対して結果を示す条件式作成のプログラムを作成したいので教えてください。

条件を満たした次の行からは基準が変わるように(条件を満たした行を基準とする)したいです。

よろしくお願いします。

A 　　　　　B　　　　　　 条件式
0.89　　　 0.00 　　　'=IF($A2<MAX($A$2:$A2)*0.5,$A2-$A$2,)
0.66　　　 0.00 　　　'=IF($A3<MAX($A$2:$A3)*0.5,$A3-$A$2,)
0.54 　　　 0.00 　　　'=IF($A4<MAX($A$2:$A4)*0.5,$A4-$A$2,)
0.85 　　　 0.00 　　　'=IF($A5<MAX($A$2:$A5)*0.5,$A5-$A$2,)
0.66 　　　 0.00 　　　'=IF($A6<MAX($A$2:$A6)*0.5,$A6-$A$2,)
0.53 　　　 0.00 　　　'=IF($A7<MAX($A$2:$A7)*0.5,$A7-$A$2,)
0.95 　　　 0.00 　　　'=IF($A8<MAX($A$2:$A8)*0.5,$A8-$A$2,)
0.32 　　　 -0.57 　　　'=IF($A9<MAX($A$2:$A9)*0.5,$A9-$A$2,)
0.03 　　　 -0.29 　　　'=IF($A10<MAX($A$9:$A10)*0.5,$A10-$A$9,)
0.51 　　　 0.00 　　　'=IF($A11<MAX($A$10:$A11)*0.5,$A11-$A$10,)
0.63 　　　 0.00 　　　'=IF($A12<MAX($A$10:$A12)*0.5,$A12-$A$10,)
0.37 　　　 0.00 　　　'=IF($A13<MAX($A$10:$A13)*0.5,$A13-$A$10,)
0.14 　　　 0.11 　　　'=IF($A14<MAX($A$10:$A14)*0.5,$A14-$A$10,)
0.38 　　　 0.00 　　　'=IF($A15<MAX($A$14:$A15)*0.5,$A15-$A$14,)
0.64 　　　 0.00 　　　'=IF($A16<MAX($A$14:$A16)*0.5,$A16-$A$14,)
0.21 　　　 0.07 　　　'=IF($A17<MAX($A$14:$A17)*0.5,$A17-$A$14,)
以下同様に計算

回答No.2

BLUEPIXY · ベストアンサー

Sub 式セット()
Dim i As Integer
Dim k As Integer
'設定する式
'=IF($A2<MAX($A$2:$A2)*0.5,$A2-$A$2,)
k = 2 '基準の行
Cells(k, 2).FormulaR1C1 = "=IF(RC1<MAX(R" & k & "C1:RC1)*0.5,RC1-R" & k & "C1,)"
i = 3
Do While Cells(i, 1).Value <> ""
If Cells(i - 1, 2).Value <> 0 Then
k = i - 1
End If
Cells(i, 2).FormulaR1C1 = "=IF(RC1<MAX(R" & k & "C1:RC1)*0.5,RC1-R" & k & "C1,)"
i = i + 1
Loop
End Sub

お礼

エレガントな回答ありがとうございます。、希望通りです。

回答No.1

noname#21649

現在ネットにつないでいるのでVBが動きません。
考え方だけ。
データの数=(適当に)
for I%=1 to データの数
データ(i%)=(適当に)
next

IMode%=0
for I%=1 to データの数
call 条件計算(データ(i%),IMode%)
next

Sub 条件計算(データ,IMode%, 計算結果)
if IMode%=0 then
(適当な計算)
if (次の条件に変更するか) then IMode%=Imode%+1
elseif IMode%=1 then
(適当な計算)
if (次の条件に変更するか) then IMode%=Imode%+1
elseif IMode%=1 then
-----(中略)------
else
'想定外のImode%値の場合
stop
end if
end sub

お礼

ありがとうございます、勉強させていただきました