根据上一个和下一个可用数据自动计算和填充 excel 个缺失值

Question

我正在做眼动追踪研究，但眼动仪并不总能吸引眼球。一个 excel 文件有 ~30k-40k 行，我想用上一个可用数据点和下一个可用数据点的平均值来填充缺失值。但是手动做会花很长时间。

我附上了一个例子table。所以X列的缺失值应该是：359.5或者四舍五入到360。而Y列的缺失值应该是134.

此外，如果可能的话，添加控制机制，如果行中有 N 个值的最大值，它只会填充缺失值。背后的想法是，如果眼动仪在短时间内没有吸引眼球，那么可以这样计算平均值，但如果它持续较长时间，那就不正确了。

Answer 1

除了定位 X 和 Y 列中的空白单元格之外，这只是简单的数学运算。

Option Explicit

Sub missingGazePoints()
    Dim blnk As Range

    With Worksheets("Sheet3")
        For Each blnk In .Columns("X:Y").SpecialCells(xlCellTypeBlanks)
            blnk = blnk.End(xlUp).Value2 + _
                  (blnk.End(xlDown).Value2 - blnk.End(xlUp).Value2) / _
                  (blnk.End(xlDown).Row - blnk.End(xlUp).Row)
        Next blnk
    End With
End Sub

请注意，我已经以线性方式填补了每个缺失的点；没有对所有缺失点使用静态平均值。

附录：使用数组

使用重复的工作表查找循环遍历行会减慢速度；可能到了崩溃的地步。将所有值（包括空白）填充到二维变量数组中并在将值返回到工作表之前在内存中执行所有处理将加快处理速度¹。

Sub qwuirwqwq()
    Dim rsz As Long, x As Long, y As Long
    Dim vals As Variant, bd As Double, ed As Double

    On Error GoTo bm_Safe_Exit  'uncomment this line when you have finished debugging
    appTGGL bTGGL:=False        'uncomment this line when you have finished debugging

    With Worksheets("Sheet3")
        With .Cells(2, "X").Resize(Application.Min(.Cells(.Rows.Count, "X").End(xlUp).Row - 1, _
                                                   .Cells(.Rows.Count, "Y").End(xlUp).Row - 1), 2)
            vals = .Cells.Value2

            For x = LBound(vals, 1) + 1 To UBound(vals, 1)
                If vals(x, 1) = vbNullString Then
                    y = x + 1
                    Do While vals(y, 1) = vbNullString
                        y = y + 1
                    Loop
                    vals(x, 1) = vals(x - 1, 1) + _
                                (vals(y, 1) - vals(x - 1, 1)) / (y - x + 1)
                End If
                If vals(x, 2) = vbNullString Then
                    y = x + 1
                    Do While vals(y, 2) = vbNullString
                        y = y + 1
                    Loop
                    vals(x, 2) = vals(x - 1, 2) + _
                                (vals(y, 2) - vals(x - 1, 2)) / (y - x + 1)
                End If
            Next x

            .Cells = vals
            ReDim vals(0)
        End With
    End With

bm_Safe_Exit:
    appTGGL

End Sub

Public Sub appTGGL(Optional bTGGL As Boolean = True)
    Application.ScreenUpdating = bTGGL
    Application.EnableEvents = bTGGL
    Application.DisplayAlerts = bTGGL
    Application.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
    Debug.Print Timer
End Sub

请注意 'helper' appTGGL 子过程，它会暂时中止各种环境设置，直到处理完成。

您还可以通过将工作簿另存为 .XLSB 而不是 .XLSM 来获得一些好处（执行速度、减小的文件大小）。

¹ _{I 运行后一种基于内存的例程在具有 i5 和 8Gbs 的平板电脑上通过 300,000 行和约 16,000 个空白单元格在 0.6 秒内完成。对，那是正确的。零点六秒.}

根据上一个和下一个可用数据自动计算和填充 excel 个缺失值

Automatically calculating and filling excel missing values based on previous and next available data

excel

vba

average

missing-data