在一张纸上过滤选择以返回结果，然后将该结果粘贴到另一张纸中

Question

问题：

我有一张包含3张的工作簿，每张都标题为“HeatNumbers”，“HeatSheetTemplate”和“Heat vs Order”。 Heat vs Order表每天都会添加一些新的数据行，因此行数总是在变化。这是列标题和一些数据的图片：

我在寻找什么：

在HeatNumbers表上，我有一个执行一些VBA代码的按钮。这是该表的图片：

以下是我需要做的事情：用户将数据输入到行J中的黑色框中的多行。每行可以包含一个FO＃。单击该按钮时，我需要通过该黑框区域中的任何FO＃过滤上面的Heat vs Order表中的所有数据，将结果集复制到HeatNumbers表，从第2行col A开始，然后删除热量与订单表中的过滤器。

我尝试了什么：

我能够实现这一目标的唯一方法是让用户手动过滤Heat vs. Order表中的数据，并将结果复制并粘贴到HeatNumbers选项卡。遗憾的是，这很麻烦且容易出错。

以下是使用宏录制器生成的代码：

Sub Filter_FO()
'
' Filter_FO Macro
'
    Range("A1:H20000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= Sheets("HeatNumbers").Range("J4:J22"), Unique:=False
    ActiveWindow.SmallScroll Down:=-15
    Range("A4:H300").Select
    Selection.Copy
    Sheets("HeatNumbers").Select
    ActiveWindow.SmallScroll Down:=-15
    Range("A2:H300").Select
    ActiveSheet.Paste
End Sub

Answer 1

为了使过滤器正常工作，您需要使用仅包含值中包含值的单元格的CriteriaRange。最简单的方法是使用.End(xlDown)函数。它的工作方式与CTRL + DOWN箭头相同，只要中间没有空格，就会选择该数据列中的最后一个单元格。

第二部分可能会改善被过滤数据的范围。现在，您正在选择一个大区域，并希望它包含您想要的数据。如果您的代码现在可以使用，您可以保留它。改进包括：

• 仅使用列字母，以便过滤整列。如果标题保留在第1行，则此方法有效。但这有点慢。
• 如果数据是一个大块，您可以使用.End(xlUp)查找最后一行并使用它。这包括在下面。

然后最后一部分是选择要复制的正确数据范围。我只是使用.SpecialCells(xlCellTypeVisible)获取了数据范围并选择了可见单元格。

为了让副本干净利落，我清除了A:H上的HeatNumbers列，以防止任何旧数据出现。当我重新粘贴数据时，我会包含标题。这是与宏的唯一真正区别。

Sub FilterDataAndClearAndCopy()

    'get references to sheets
    Dim sht_data As Worksheet
    Dim sht_filter As Worksheet

    Set sht_data = Sheets("Heat vs Order")
    Set sht_filter = Sheets("HeatNumbers")

    'get the block of data to set the filter over
    Dim rng_data As Range
    Dim int_lastRow As Integer

    int_lastRow = sht_data.Range("A" & sht_data.Rows.Count).End(xlUp).Row
    Set rng_data = sht_data.Range("A1:H" & int_lastRow)

    'get the criteria range... assumes at least one entry below J3
    Dim rng_filter As Range
    Set rng_filter = Range(sht_filter.Range("J3"), sht_filter.Range("J3").End(xlDown))

    'filter the data
    rng_data.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rng_filter, Unique:=False

    'clear out data
    sht_filter.Range("A:H").Clear

    'select data to copy
    rng_data.SpecialCells(xlCellTypeVisible).Copy

    'paste that data to filter sheet
    sht_filter.Range("A1").PasteSpecial xlPasteAll

    'remove the filter
    sht_data.ShowAllData

End Sub