Excel VBA实现列非空值按下方空单元格数均分后删除原行

原有代码问题 #

• 从上到下遍历的逻辑在执行删行操作时会出现行号偏移，直接导致数据错漏、遍历死循环
• 未覆盖列尾最后一个非空值的边界场景，遇到最后一段数据会直接跳出不处理
• 未实现原始数值行的删除逻辑，和需求目标不符

可直接运行的实现代码 #

Sub FillAvgAndDeleteSource()
    Dim ws As Worksheet
    Dim targetCol As Long, lastRow As Long, startRow As Long
    Dim i As Long, emptyCount As Long, currentVal As Double
    Dim delRows As Range
    
    ' ========== 可根据实际场景修改以下配置 ==========
    Set ws = ActiveSheet ' 处理当前激活的工作表，可指定为Sheets("你的表名")
    targetCol = 11       ' 要处理的列号，11对应K列，B列填2即可
    startRow = 1         ' 数据起始行，有表头则改为2
    ' ==============================================
    
    lastRow = ws.Cells(ws.Rows.Count, targetCol).End(xlUp).Row
    Set delRows = Nothing
    i = startRow
    
    Do While i <= lastRow
        ' 定位到非空的原始数值单元格
        If ws.Cells(i, targetCol).Value <> "" Then
            currentVal = ws.Cells(i, targetCol).Value
            emptyCount = 0
            ' 统计当前单元格下方连续的空单元格总数
            Do While i + emptyCount + 1 <= lastRow _
                And ws.Cells(i + emptyCount + 1, targetCol).Value = ""
                emptyCount = emptyCount + 1
            Loop
            
            If emptyCount > 0 Then
                ' 计算均值并填充到所有连续空单元格
                ws.Range(ws.Cells(i + 1, targetCol), ws.Cells(i + emptyCount, targetCol)).Value = currentVal / emptyCount
                ' 将当前原始数值行加入待删除队列
                If delRows Is Nothing Then
                    Set delRows = ws.Rows(i)
                Else
                    Set delRows = Union(delRows, ws.Rows(i))
                End If
            End If
            ' 跳过已处理的空单元格，直接定位到下一个非空值
            i = i + emptyCount + 1
        Else
            i = i + 1
        End If
    Loop
    
    ' 所有填充完成后，批量删除所有原始数值行，避免逐行删除导致的行号错位
    If Not delRows Is Nothing Then delRows.Delete
End Sub

逻辑说明 #

• 采用先统计、填充，最后批量删行的处理顺序，完全规避删行带来的位置偏移问题
• 自动适配边界场景：如果某非空单元格下方没有连续空单元格（比如列最后一行的值），会直接保留该值，不会误删
• 计算逻辑完全匹配需求：除数为当前值下方连续空单元格的总数量，不会出现额外+1的偏差
• 逐段定位非空值，不会漏处理任何一段数据

内容的提问来源于stack exchange，提问作者Alexandre Rua