&l
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 t;script type="text/javascript"> 0000;"> '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
'寻找时间临近的记录
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 0 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) ^ 2 * (Cells(timeRow - j, timecolumn).Value - Cells((resultRows(i) - 5),
2).Value) ^ 2 + 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) ^ 2 * (Cells(timeRow - j, timecolumn).Value - Cells((resultRows(i) - 5),
2).Value) ^ 2 + 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
'寻找时间临近的记录
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 t;script type="text/javascript"> 0000;"> '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
'寻找时间临近的记录
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 0 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) ^ 2 * (Cells(timeRow - j, timecolumn).Value - Cells((resultRows(i) - 5),
2).Value) ^ 2 + 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) ^ 2 * (Cells(timeRow - j, timecolumn).Value - Cells((resultRows(i) - 5),
2).Value) ^ 2 + 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