根据上面的非空白单元格填充空白单元格

Posted 2023-02-24

【中文标题】根据上面的非空白单元格填充空白单元格

【英文标题】：Fill blank cells based on non blank cell above

【发布时间】：2020-06-20 01:05:44

【问题描述】：

我想根据上面的单元格按顺序填充空白单元格。

F列填充的区间不一致。需要根据上面的项目编号填写两行，最多 20 行。

需要 VBA 而不是公式。

此代码将复制非空白上方的项目并将其粘贴下来。

Sub FillBlanks()
Columns("F:F").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C" 
End Sub

我需要的是按顺序自动填充，直到下一个非空白。

类似：

OA205S061169
OA205S061170
OA205S061171
OA205S061172
OA205S061173
OA205S061174

【参考方案1】：

您可以选择空白单元格，就像您已经在做的那样，然后遍历每个区域，如下所示...

Sub FillBlanks()

    Dim lastRow As Long
    Dim dataRange As Range
    Dim currentArea As Range

    lastRow = Cells(Rows.Count, "F").End(xlUp).Row

    On Error Resume Next
    Set dataRange = Range("F1:F" & lastRow).SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0

    If Not dataRange Is Nothing Then
        For Each currentArea In dataRange.Areas
            With currentArea
                With .Offset(-1, 0).Resize(.Rows.Count + 1)
                    .Cells(1).AutoFill Destination:=.Cells, Type:=xlFillDefault
                End With
            End With
        Next currentArea
    End If

End Sub

请注意，它使用列 F 来查找最后使用的行。但是，根据您的数据，您可能需要使用其他列来确定最后使用的行。例如，要使用 A 列，请改用以下内容...

lastRow = Cells(Rows.Count, "A").End(xlUp).Row

【讨论】：

完美...非常感谢您的帮助

【参考方案2】：

试试

Sub FillTest()
    Dim rngDB As Range
    Dim vDB, vSplit
    Dim i As Long, x As Long, n As Integer
    Dim s As String

    Set rngDB = Range("f1", Range("f" & Rows.Count).End(xlUp))
    vDB = rngDB

    For i = 1 To UBound(vDB, 1)
        If vDB(i, 1) <> "" Then
            vSplit = Split(vDB(i, 1), "S")
            s = vSplit(0) & "S"
            x = vSplit(1)
            n = 0
        Else
            n = n + 1
            vDB(i, 1) = s & Format(x + n, "000000")
        End If
    Next i
    rngDB = vDB
End Sub

【讨论】：

完美...非常感谢您的帮助。