寻找时间临近的记录中Hermite插值
Code
'寻找时间临近的记录
Sub findNearTime()
Dim searchTimecolumn As Integer 'search值所在列
Dim searchTimeBeginRow As Integer 'search值开始行
Dim searchTimeEndRow As Integer 'search值结束行
searchTimecolumn = 1
searchTimeBeginRow = 2
searchTimeEndRow = 201 '-------------
Dim timecolumn As Integer 'time所在列
Dim timeBeginRow As Integer 'time值开始行
Dim timeEndRow As Integer 'time值结束行
timecolumn = 2
timeBeginRow = 2
timeEndRow = 1000 '--------------
Dim endColumn As Integer '目标属性结束列
endColumn = 10
Dim searchRow As Integer '当前搜索行
Dim resultRows(199) As Integer
Dim i As Integer
Dim j As Integer
Dim timeRow As Integer '当前对比时间行
Dim RedRandom As Integer '随机数(以生成随机颜色)
Dim GreenRandom As Integer
Dim BlueRandom As Integer
i = 0
Dim beginNum As Integer
Dim endNum As Integer
beginNum = 4
endNum = 1
Dim c0 As Double
Dim c1 As Double
Dim c2 As Double
Dim c3 As Double
Dim timespan As Integer
'寻找时间临近的记录
For searchRow = searchTimeBeginRow To searchTimeEndRow '对搜索time循环
RedRandom = Int(Rnd() * 200 + 50)
GreenRandom = Int(Rnd() * 200 + 50)
BlueRandom = Int(Rnd() * 200 + 50)
Dim score As Integer '用来标识搜索结果time的符合级别
score = 0
Dim selectRow As Integer '存储符合搜索条件的time的Row值
selectRow = 0
Dim searchValue As Double
searchValue = Cells(searchRow, searchTimecolumn).Value '当前搜索time
For timeRow = timeBeginRow To timeEndRow '对time列表进行循环
Dim timeValue As Double
timeValue = Cells(timeRow, timecolumn).Value '当前取到拿来对比的time
If timeValue - searchValue = 0 Then '若相等
selectRow = timeRow
resultRows(i) = selectRow
If (i) Then
c0 = Cells((resultRows(i) - 5), 7).Value
c1 = Cells((resultRows(i) - 5), 11).Value
T = Cells(resultRows(i), 2).Value - Cells((resultRows(i) - 5), 2).Value
c2 = (-3) / T ^ 2 * c0 - 2 / T * c1 + 3 / T ^ 2 * Cells(resultRows(i),
7).Value - 1 / T * Cells(resultRows(i), 11).Value
c3 = 2 / T ^ 3 * c0 + 1 / T ^ 2 * c1 - 2 / T ^ 3 * Cells(resultRows(i),
7).Value + 1 / T ^ 2 * Cells(resultRows(i), 11).Value
On Error Resume Next
For j = beginNum To endNum Step -1
timespan = Cells(timeRow - j, timecolumn).Value - Cells((resultRows(i) -
5), 2).Value
Cells(timeRow - j, 12).Value = c0 + c1 * timespan + c2 * timespan ^ 2 +
c3 * timespan ^ 3
Next
End If
i = i + 1
ElseIf timeValue - searchValue < 0 Then '若取得时间值小于搜索时间
selectRow = timeRow
ElseIf timeValue - searchValue > 0 Then '若取得时间值大于搜索时间
If (timeValue + Cells(timeRow - 1, timecolumn).Value - 2 * searchValue <
0) Then '判断哪个更近
selectRow = timeRow
End If
End If
Next
Next
End Sub
'寻找时间临近的记录
Sub findNearTime()
Dim searchTimecolumn As Integer 'search值所在列
Dim searchTimeBeginRow As Integer 'search值开始行
Dim searchTimeEndRow As Integer 'search值结束行
searchTimecolumn = 1
searchTimeBeginRow = 2
searchTimeEndRow = 201 '-------------
Dim timecolumn As Integer 'time所在列
Dim timeBeginRow As Integer 'time值开始行
Dim timeEndRow As Integer 'time值结束行
timecolumn = 2
timeBeginRow = 2
timeEndRow = 1000 '--------------
Dim endColumn As Integer '目标属性结束列
endColumn = 10
Dim searchRow As Integer '当前搜索行
Dim resultRows(199) As Integer
Dim i As Integer
Dim j As Integer
Dim timeRow As Integer '当前对比时间行
Dim RedRandom As Integer '随机数(以生成随机颜色)
Dim GreenRandom As Integer
Dim BlueRandom As Integer
i = 0
Dim beginNum As Integer
Dim endNum As Integer
beginNum = 4
endNum = 1
Dim c0 As Double
Dim c1 As Double
Dim c2 As Double
Dim c3 As Double
Dim timespan As Integer
'寻找时间临近的记录
For searchRow = searchTimeBeginRow To searchTimeEndRow '对搜索time循环
RedRandom = Int(Rnd() * 200 + 50)
GreenRandom = Int(Rnd() * 200 + 50)
BlueRandom = Int(Rnd() * 200 + 50)
Dim score As Integer '用来标识搜索结果time的符合级别
score = 0
Dim selectRow As Integer '存储符合搜索条件的time的Row值
selectRow = 0
Dim searchValue As Double
searchValue = Cells(searchRow, searchTimecolumn).Value '当前搜索time
For timeRow = timeBeginRow To timeEndRow '对time列表进行循环
Dim timeValue As Double
timeValue = Cells(timeRow, timecolumn).Value '当前取到拿来对比的time
If timeValue - searchValue = 0 Then '若相等
selectRow = timeRow
resultRows(i) = selectRow
If (i) Then
c0 = Cells((resultRows(i) - 5), 7).Value
c1 = Cells((resultRows(i) - 5), 11).Value
T = Cells(resultRows(i), 2).Value - Cells((resultRows(i) - 5), 2).Value
c2 = (-3) / T ^ 2 * c0 - 2 / T * c1 + 3 / T ^ 2 * Cells(resultRows(i),
7).Value - 1 / T * Cells(resultRows(i), 11).Value
c3 = 2 / T ^ 3 * c0 + 1 / T ^ 2 * c1 - 2 / T ^ 3 * Cells(resultRows(i),
7).Value + 1 / T ^ 2 * Cells(resultRows(i), 11).Value
On Error Resume Next
For j = beginNum To endNum Step -1
timespan = Cells(timeRow - j, timecolumn).Value - Cells((resultRows(i) -
5), 2).Value
Cells(timeRow - j, 12).Value = c0 + c1 * timespan + c2 * timespan ^ 2 +
c3 * timespan ^ 3
Next
End If
i = i + 1
ElseIf timeValue - searchValue < 0 Then '若取得时间值小于搜索时间
selectRow = timeRow
ElseIf timeValue - searchValue > 0 Then '若取得时间值大于搜索时间
If (timeValue + Cells(timeRow - 1, timecolumn).Value - 2 * searchValue <
0) Then '判断哪个更近
selectRow = timeRow
End If
End If
Next
Next
End Sub