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

时间:2017-03-22 15:37:36

标签: excel vba excel-vba average missing-data

我正在进行眼动追踪研究,但眼动仪并不总能吸引眼球。一个excel文件有大约30k-40k行,我想用以前可用和下一个可用数据点的平均值填充缺失值。但手动完成它将需要永远。

我附上了一个表的例子。因此,X列中的缺失值应为:359.5或舍入为360.Y列缺失值应为134.

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

Excel table example

1 个答案:

答案 0 :(得分: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

请注意,我已经以线性方式填补了每个缺失的点;没有使用所有缺失点的静态平均值。 enter image description here

附录:使用数组

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

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行~100,000个空白单元的后一个基于内存的例行程序。对,那是正确的。零点六秒钟。