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

【问题标题】：Filter a selection on one sheet to return a result and then paste that result into a different sheet在一张纸上过滤选择以返回结果，然后将该结果粘贴到另一张纸中
【发布时间】：2015-04-16 23:02:30
【问题描述】：

问题：

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

我在寻找什么：

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

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

我尝试过的：

我能够做到这一点的唯一方法是让用户手动过滤 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

【问题讨论】：

现在运行宏时发生了什么？你能显示你的宏吗？
这是一个您可以录制宏并非常接近最终结果的地方。您将需要使用AutoFilter 并将其输入该用户输入的值。（也有助于在粘贴图片时包含列标签）。
@Jaycal 现在运行的宏对需要过来的数据进行排序，然后从 SQL 表中导入一些数据。该代码运行良好。
@ByronWall 这是个好建议。我想这就是我要走的路。我什至没有想到。对这张照片感到抱歉。发帖后才看到。应该已经编辑了。
@ByronWall 不幸的是，这在使用自动过滤器和录制宏时不起作用。当我选择整个区域作为过滤条件，但该区域只有一两条数据时，它不会过滤。

标签： vba excel

【解决方案1】：

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

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

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

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

为了使副本干净地工作，我清除了 HeatNumbers 上的列 A:H 以防止任何旧数据闲置。当我将数据粘贴回来时，我会包含标题。这是与您的宏的唯一真正区别。

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

【讨论】：