エクセルにて、3次スプラインのマクロを組みました。

質問

エクセルにて、3次スプラインのマクロを組みました。
結果がところどころしか表示されません。
何度見直しても自分では間違いがわかりません。
どなたか、間違い箇所がわかりませんでしょうか。

A列には5行目から、0-720までの721個の少数値
0
1.005586592
2.011173184

B列には5行目から、721個の少数値
5.83
5.69
5.66

D列には5行目から、0-720まで、1ずつ増加の整数値
0
1
2

E列には補間値をマクロから代入
以下マクロです。
お手数をおかけしますが、目を通して指摘していただけませんでしょうか。

Sub 補間_3次スプライン()

Dim i As Long
Dim h(1000) As Double
Dim dif1(1000) As Double
Dim dif2(1000) As Double
Dim data_count As Long
Dim lngDataEnd As Long
Dim dataX(1000) As Double
Dim dataY(1000) As Double
Dim x, y, yy0, yy1, yy2, yy3 As Double
lngDataEnd = ThisWorkbook.Sheets("3次スプライン").Range("A65536").End(xlUp).Row
data_count = lngDataEnd - 5

For i = 1 To data_count
dataX(i) = ThisWorkbook.Sheets("3次スプライン").Cells(i + 4, 1)
dataY(i) = ThisWorkbook.Sheets("3次スプライン").Cells(i + 4, 2)
Next i

h(0) = 0
dif2(0) = 0

On Error Resume Next
For i = 1 To data_count
h(i) = dataX(i) - dataX(i - 1) '//間隔を計算
dif1(i) = (dataY(i) - dataY(i - 1)) / h(i) '//一次微分を計算
Next i

For i = 1 To data_count
'二次微分を計算
dif2(i) = (dif1(i + 1) - dif1(i)) / (dataX(i + 1) - dataX(i - 1))
Next i

i = 1
For x = 0 To 720
If x < dataX(i) Then
yy0 = dif2(i - 1) / (6 * h(i)) * (dataX(i) - x) * (dataX(i) - x) * (dataX(i) - x) '第１項
yy1 = dif2(i) / (6 * h(i)) * (x - dataX(i - 1)) * (x - dataX(i - 1)) * (x - dataX(i - 1)) '第２項
yy2 = (dataY(i - 1) / h(i) - h(i) * dif2(i - 1) / 6) * (dataX(i) - x) '第３項
yy3 = (dataY(i) / h(i) - h(i) * dif2(i) / 6) * (x - dataX(i - 1)) '第４項
y = yy0 + yy1 + yy2 + yy3
ThisWorkbook.Sheets("3次スプライン").Cells(x + 4, 5) = y
Else: i = i + 1
End If
Next x
End Sub

回答No.1

nag0720 · ベストアンサー

3次スプラインの計算式は確認していないので、それは置いておくとして、
結果がところどころしか表示されない原因は、最後のほうの
If x < dataX(i) Then
の部分ではないでしょうか。
この方法では、「If x < dataX(i) Then」を満たさなければ、そのxの行は表示されません。

次のようにしてはどうですか。

i = 1
For x = 0 To 720
Do Until x < dataX(i)
i = i + 1
If i > data_count Then Exit Do
Loop
If i > data_count Then Exit For
yy1 = ・・・・・
・・・・・・・
ThisWorkbook.Sheets("3次スプライン").Cells(x + 4, 5) = y
Next x

お礼

バッチリでした！
ありがとうございます。