寻找临近的记录中等速插值

&

 

'寻找时间临近的记录
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
    
amp;nbsp;   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
    
    
    

    '寻找时间临近的记录
    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
                
               For j = beginNum To endNum Step -1
                Cells(timeRow - j, 10).Value = (Cells(resultRows(i), 7).Value - Cells

((resultRows(i) - 5), 7).Value) / (Cells(resultRows(i), 2).Value - Cells((resultRows(i) - 

5), 2).Value) * (Cells(timeRow - j, timecolumn).Value - Cells((resultRows(i) - 5), 

2).Value) + Cells((resultRows(i) - 5), 7).Value
               
               
               Cells(timeRow - j, 11).Value = (Cells(resultRows(i), 8).Value - Cells

((resultRows(i) - 5), 8).Value) / (Cells(resultRows(i), 2).Value - Cells((resultRows(i) - 

5), 2).Value) * (Cells(timeRow - j, timecolumn).Value - Cells((resultRows(i) - 5), 

2).Value) + Cells((resultRows(i) - 5), 8).Value
               
              Cells(timeRow - j, 12).Value = Sqr((Cells(timeRow - j, 10).Value - Cells

(timeRow - j, 7).Value) * (Cells(timeRow - j, 10).Value - Cells(timeRow - j, 7).Value) + 

(Cells(timeRow - j, 11).Value - Cells(timeRow - j, 8).Value) * (Cells(timeRow - j, 

11).Value - Cells(timeRow - j, 8).Value))
               Next
          
               
                End If
                
                i = i + 1
                
                GoTo mark
                
            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
        
mark:
        '搜索得到结果变色
        If selectRow > 0 Then
            Cells(searchRow, 1).Select
            With Selection.Interior
                .Pattern = xlSolid

                .Color = RGB(RedRandom, GreenRandom, BlueRandom)
            End With
            
            Range(Cells(selectRow, 2), Cells(selectRow, 10)).Select
            With Selection.Interior
                .Pattern = xlSolid

                .Color = RGB(RedRandom, GreenRandom, BlueRandom)
            End With
        End If
        
    Next

End Sub