使用VBA进行线性插值

Sub LinInterp()
 Dim rKnown As Range '已知数值的区域
 Dim rGap As Range '插值区域
 Dim dLow As Double '最小值
 Dim dHigh As Double '最大值
 Dim dIncr As Double '增加值
 Dim cntGapCells As Long '填充插值的单元格数
 Dim iArea As Long '区域数变量
 Dim iGap As Long '插值变量
 
 '赋已知数组成的单元格区域给变量
 Set rKnown = ActiveSheet.Columns(1).SpecialCells(xlCellTypeConstants, xlNumbers)
 With rKnown
   '遍历已知道区域并将其值复制到相邻列插值区
   For iArea = 1 To .Areas.Count
     .Areas(iArea).Cells(1, 2).Value = .Areas(iArea).Cells(1, 1).Value
   Next iArea
 
   '遍历要放置插值数据的区域
   For iArea = 1 To .Areas.Count - 1
     '计算放置插值数据区域的单元格数
     cntGapCells = .Areas(iArea + 1).Cells(1, 1).Row - .Areas(iArea).Cells(1, 1).Row - 1
     '获取最小值
     dLow = .Areas(iArea).Cells(1, 1).Value
     '获取最大值
     dHigh = .Areas(iArea + 1).Cells(1, 1).Value
     '计算增加值
     dIncr = (dHigh - dLow) / cntGapCells
 
     '遍历放置插值数据区域的单元格并输入数据
     For iGap = .Areas(iArea).Cells(1, 1).Row + 1 To .Areas(iArea + 1).Cells(1, 1).Row - 1
       ActiveSheet.Cells(iGap, 2).Value = ActiveSheet.Cells(iGap - 1, 2).Value + dIncr
     Next iGap
   Next iArea
 End With
End Sub