过滤和自动填充后查找 A 列中的第一个空白单元格

Question

我正在尝试在用户窗体按钮中编写一个子例程来执行以下操作

1. 从输入的文本框中收集数据
2. 使用文本框过滤第 6 列（生产线）
3. 过滤后，使用代码块在 A 列中查找第一个过滤后为空的单元格
4. 当它找到第一个可见的空单元格时，尝试使用顶部的行自动填充单元格（由于公式）

这是我目前的代码。

Private Sub GenerateNewPartID_Click()
    'grabs all the information entered by user and creates a new row and autofillsName  Current Inventory    a new ID

    'this filters field 6 which is for production line so that we can create Part ID specific to that production line
    ActiveSheet.Range("A1:L1").AutoFilter Field:=6, Criteria1:=NewProductionLine.Value

    'Finds the first empty cell in column A so that it can generate a new part ID
    Worksheets("Home Page").Range("A1").Select
    With Worksheets(1).Range("A:A")
        Cells.Find(What:="", After:=ActiveCell, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Activate
    End With
    
    Range(ActiveCell.Offset(-3, 0), ActiveCell.Offset(-1, 0)).Select
    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.Offset(3, 0)), Type:=xlFillDefault
    ActiveCell.Offset(3, 0).Select
    
    'Populates the cells with the information entered by user
    NewPartID = ActiveCell.Value
    ActiveCell.Offset(0, 1).Value = NewPartNumber
    ActiveCell.Offset(0, 2).Value = NewPartName
    ActiveCell.Offset(0, 4).Value = NewCurrentInventory
    ActiveCell.Offset(0, 5).Value = NewProductionLine
    ActiveCell.Offset(0, 6).Value = NewLocation
    ActiveCell.Offset(0, 7).Value = NewSupplier
    ActiveCell.Offset(0, 8).Value = NewPrice
    ActiveCell.Offset(0, 9).Value = NewFloat
    ActiveCell.Offset(0, 10).Value = NewPlantManual
    ActiveCell.Offset(-1, 11).Select
    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.Offset(1, 0)), Type:=xlFillDefault

End Sub

问题在于上面的代码，它可以在没有我的字段 6 的自动筛选的情况下工作，即它将在范围 A:A 中找到第一个空单元格，例如如果 A59 是最后一个填充的单元格，则为 A60。但是，一旦我添加字段 6 的自动过滤器，查找功能就会转到单元格 M1。这会引发我的自动填充函数的错误，因为它试图选择第 1 行上方不存在的行。

我想知道应用过滤器时查找功能是否出现故障。有办法解决这个问题吗？我真的不想使用 Do 循环，因为我有点担心这个循环会导致问题。

预先感谢您的帮助

编辑： 添加我正在过滤的列标题并显示自动填充的作用。基本上这是一个数据库电子表格，因为我有确定短缺的公式以及生产线特定零件 ID，所以我使用自动填充功能来获取下一个零件 ID 和短缺公式

https://i.sstatic.net/aeF0g.png

Answer 1

我的方法是使用辅助函数来让我像处理表格一样处理数据。我将问题分解为处理很少任务的简单方法。

• wsHomePage：引用主页工作表
• ProductionLineRange：定义包含数据和标题的范围
• ProductionLineHeaderRowRange：返回标题行
• ProductionLineDataBodyRange：包含数据的范围 ProductionLineNewRow
• ：返回下一个可用行
• ProductionLineIDColumn：定义 ID 列
• ProductionLineNextID：返回 ID列最大值 + 1
• AppendProductionLine：填写任何公式并将值附加到新行
• TestRanges：打印我所有范围的地址

-- 注意：我在编写 Range 函数时使用 Application.Goto Range

• TestAddNewRow：添加 20 个新行

重构

Private Sub GenerateNewPartID_Click()
    'grabs all the information entered by user and creates a new row and autofillsName  Current Inventory    a new ID

    'this filters field 6 which is for production line so that we can create Part ID specific to that production line
    ProductionLineHeaderRowRange.AutoFilter Field:=6, Criteria1:=NewProductionLine.Value

    Rem Display the Home Page
    Application.Goto wsHomePage.Range("A1")

    AppendProductionLine ProductionLineNextID, NewPartNumber, NewPartName, , NewCurrentInventory, NewProductionLine, NewLocation, NewSupplier, NewPrice, NewFloat, NewPlantManual

End Sub

Function wsHomePage() As Worksheet
    Set wsHomePage = ThisWorkbook.Worksheets("Home Page")
End Function

Function ProductionLineRange() As Range
    Set ProductionLineRange = wsHomePage.Range("A1").CurrentRegion
End Function

Function ProductionLineHeaderRowRange() As Range
    Set ProductionLineHeaderRowRange = ProductionLineRange.Rows(1)
End Function

Function ProductionLineDataBodyRange() As Range
    If ProductionLineRange.Rows.Count = 1 Then Exit Function
    With ProductionLineRange
        Set ProductionLineDataBodyRange = .Offset(1).Resize(.Rows.Count - 1)
    End With
End Function

Function ProductionLineNewRow() As Range
    With ProductionLineRange
        Set ProductionLineNewRow = .Rows(.Rows.Count + 1)
    End With
End Function

Function ProductionLineIDColumn() As Range
    Set ProductionLineIDColumn = ProductionLineRange.Columns(1)
End Function

Function ProductionLineNextID() As Long
    ProductionLineNextID = WorksheetFunction.Max(ProductionLineIDColumn) + 1
End Function

Sub AppendProductionLine(ParamArray Args() As Variant)
    Dim NewRow As Range
    Set NewRow = ProductionLineNewRow
    
    Dim Destination As Range
    Rem Define a Range that Extends the DataBodyRange to incude the NewRow
    Set Destination = Union(ProductionLineDataBodyRange, ProductionLineNewRow)
    ProductionLineDataBodyRange.AutoFill Destination:=Destination, Type:=xlFillDefault
    
    NewRow.Cells(1, 1).Value = ProductionLineNextID
    Dim c As Long
    For c = 0 To UBound(Args)
        If Not IsMissing(Args(c)) Then NewRow.Cells(1, c + 2).Value = Args(c)
    Next
End Sub

Sub TestRanges()
    Debug.Print "Range", ProductionLineRange.Address(0, 0)
    Debug.Print "Header", ProductionLineHeaderRowRange.Address(0, 0)
    Debug.Print "DataBodyRange", ProductionLineDataBodyRange.Address(0, 0)
    Debug.Print "ProductionLineNewRow", ProductionLineNewRow.Address(0, 0)
    Debug.Print "ProductionLineIDColumn", ProductionLineIDColumn.Address(0, 0)
    Debug.Print "Next ID", ProductionLineNextID()
End Sub

Sub TestAddNewRow()
    Dim n As Long
    For n = 1 To 20
        AppendProductionLine "NewPartNumber", "NewPartName", Now, "NewCurrentInventory", "NewProductionLine", "NewLocation", "NewSupplier", "NewPrice", "NewFloat", "NewPlantManual"
    Next
End Sub