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

Question

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

我附上了表格的示例。所以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

请注意“助手”appTGGL 子过程，它会暂时挂起税务处理的各种环境设置，直到处理完成。

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

---

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