Question

我有三个感兴趣的列：一列有时间戳，以毫秒为单位，两列有数据。如果存在包含数据1的行，则具有数据2的单元格为空，反之亦然。现在我想通过线性插值填充空单元格。数据的顺序是可变的，时间戳的差异也是可变的。

timestamp 1  data 1
timestamp 2  data 1
timestamp 3  data 1
timestamp 4          data 2
timestamp 5  data 1
timestamp 6          data 2
timestamp 7          data 2
timestamp 8  data1
timestamp 9  data1

我想过以某种方式使用趋势功能，但我不知道如何管理只有最后一行bevore和第一行＆＃34;整个＆＃34;用于根据时间戳内插值。有什么想法？

非常感谢您的建议!! 弗洛里安

Answer 1

对于每个循环，快速完成内部值的插值。

Sub interpolate()
For Each cell In Range("B1:B14")
    If cell.Value = "" Then
        y2 = cell.End(xlDown).Value
        x2 = cell.End(xlDown).Offset(0, -1).Value
        y1 = cell.End(xlUp).Value
        x1 = cell.End(xlUp).Offset(0, -1).Value
        x = cell.Offset(0, -1).Value
        y = (y1) + (x - x1) * (y2 - y1) / (x2 - x1)
        cell.Value = y
    End If
Next
End Sub

正如您所正确识别的那样，这种方法可以正确地解决边界处的空白空间，并且会破坏。如果时间戳和数据之间的关系是可靠的线性，您可以修改一点以将已知数据外推到边界位置。例如，通过对插值方程中的y1和y2使用data2（t = 4）和data2（t = 6）。如果您确保首先应用此推断，填充边界位置，则前面的代码应适用于整个范围。或者，您可以为整个数据集执行趋势。但请记住，这是一条直线的最小二乘拟合，只有在数据是时间的线性函数时才有效。如果不是，那将完全骗你。我的解决方案在下面，应该可行，但我完全是黑客，所以它可能不够优雅和混乱。

Sub trendlinefit()
Dim xData1() As Double
Dim yData1() As Double
Dim newxData1() As Double
Dim xData2() As Double
Dim yData2() As Double
Dim newxData2() As Double
Dim tcell As Range

Set rangeData1 = Range("B1:B14")
Set rangeData2 = Range("C1:C14")
Set tcell = Range("G18")

'loops through data 1 cells and builds arrays for known and needed values'
a = 0
b = 0
For Each cell1 In rangeData1
    If cell1.Value <> "" Then
        ReDim Preserve xData1(a)
        ReDim Preserve yData1(a)
        xData1(a) = cell1.Offset(0, -1).Value   'unknown x value for data 1'
        yData1(a) = cell1.Value                 'unknown y value for data 1'
        a = a + 1
    ElseIf cell1.Value = "" Then
        ReDim Preserve newxData1(b)
        newxData1(b) = cell1.Offset(0, -1).Value    'missing x value data 1'
        b = b + 1
    End If
Next

'loops through data 2 cells and builds arrays for known and needed values'
j = 0
k = 0
For Each cell2 In rangeData2
    If cell2.Value <> "" Then
        ReDim Preserve xData2(j)
        ReDim Preserve yData2(j)
        xData2(j) = cell2.Offset(0, -2).Value   'unknown x value for data 2'
        yData2(j) = cell2.Value                 'unknown y value for data 2'
        j = j + 1
    ElseIf cell2.Value = "" Then
        ReDim Preserve newxData2(k)
        newxData2(k) = cell2.Offset(0, -2).Value    'missing x value data 2'
        k = k + 1
    End If
Next

'curve fitting functions. In this case, Trend.'
result1 = WorksheetFunction.Trend(yData1, xData1, newxData1)
result2 = WorksheetFunction.Trend(yData2, xData2, newxData2)

'populate data1 with result1' 
q = 1
For Each fcell1 In rangeData1
    If fcell1.Value = "" Then
        fcell1.Value = result1(q)
        q = q + 1
    End If
Next

'populate data2 with result2'
r = 1
For Each fcell2 In rangeData2
    If fcell2.Value = "" Then
        fcell2.Value = result2(r)
        r = r + 1
    End If
Next

End Sub

大多数代码只生成数组供趋势函数使用（向下）。如果数据不是线性的，你可能需要废弃趋势函数，并通过一些更复杂的曲线拟合技术生成result1和result2，这将使你有更好的机会计算这些边界值。不幸的是，任何方法都需要一些设计输入，但希望这可以让你开始。

如何通过线性插值填充空单元格

1 个答案: