Question

我使用AutoFilter对VBA中的表进行排序，从而产生较小的数据表。我只想在应用过滤器后复制/粘贴一列的可见单元格。另外，我想平均一列的过滤值并将结果放在不同的单元格中。

我在Stack上找到了这个片段，它允许我复制/粘贴过滤器的整个可见结果，但我不知道如何修改它或以其他方式只获得一列的数据（没有标题）来自它。

Range("A1",Cells(65536,Cells(1,256).End(xlToLeft).Column).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

添加回答（使用过滤后的值进行计算）：

tgt.Range("B2").Value =WorksheetFunction.Average(copyRange.SpecialCells(xlCellTypeVisible))

Answer 1

我在Sheet1上设置了一个简单的3列范围，包括A，B和C列中的国家/地区，城市和语言。以下代码自动过滤范围，然后仅将其中一列自动过滤数据粘贴到另一个工作表。您应该可以为此目的修改此内容：

Sub CopyPartOfFilteredRange()
    Dim src As Worksheet
    Dim tgt As Worksheet
    Dim filterRange As Range
    Dim copyRange As Range
    Dim lastRow As Long

    Set src = ThisWorkbook.Sheets("Sheet1")
    Set tgt = ThisWorkbook.Sheets("Sheet2")

    ' turn off any autofilters that are already set
    src.AutoFilterMode = False

    ' find the last row with data in column A
    lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row

    ' the range that we are auto-filtering (all columns)
    Set filterRange = src.Range("A1:C" & lastRow)

    ' the range we want to copy (only columns we want to copy)
    ' in this case we are copying country from column A
    ' we set the range to start in row 2 to prevent copying the header
    Set copyRange = src.Range("A2:A" & lastRow)

    ' filter range based on column B
    filterRange.AutoFilter field:=2, Criteria1:="Rio de Janeiro"

    ' copy the visible cells to our target range
    ' note that you can easily find the last populated row on this sheet
    ' if you don't want to over-write your previous results
    copyRange.SpecialCells(xlCellTypeVisible).Copy tgt.Range("A1")

End Sub

请注意，通过使用上述语法进行复制和粘贴，不会选择或激活任何内容（在Excel VBA中应始终避免这种情况），并且不使用剪贴板。因此，Application.CutCopyMode = False不是必需的。

Answer 2

如果您需要更进一步，只需要添加Jon的编码，并且只需要添加一列，就可以添加类似

的内容。

Dim copyRange2 As Range
Dim copyRange3 As Range

Set copyRange2 =src.Range("B2:B" & lastRow)
Set copyRange3 =src.Range("C2:C" & lastRow)

copyRange2.SpecialCells(xlCellTypeVisible).Copy tgt.Range("B12")
copyRange3.SpecialCells(xlCellTypeVisible).Copy tgt.Range("C12")

将这些放在相同的其他编码附近，您可以根据需要轻松更改范围。

我只添加这个，因为它对我有帮助。我假设Jon已经知道这一点，但对于那些经验不足的人来说，有时看看如何更改/添加/修改这些编码会很有帮助。我想，因为Ruya不知道如何操作原始编码，如果只需要复制2个可见列，或只有3个等，可能会有所帮助。您可以使用相同的编码，添加几乎是额外的行同样然后编码复制你需要的任何东西。

我没有足够的声誉来直接回复Jon的评论所以我必须发布一个新的评论，抱歉。

Answer 3

此处是与Windows office 2010 一起使用的代码。该脚本将询问您输入的单元格过滤范围，然后是粘贴范围。

请，两个范围应具有相同数量的单元格。

Sub Copy_Filtered_Cells()

Dim from As Variant
Dim too As Variant
Dim thing As Variant
Dim cell As Range

'Selection.SpecialCells(xlCellTypeVisible).Select

    'Set from = Selection.SpecialCells(xlCellTypeVisible)
    Set temp = Application.InputBox("Copy Range :", Type:=8)
    Set from = temp.SpecialCells(xlCellTypeVisible)
    Set too = Application.InputBox("Select Paste range selected cells ( Visible cells only)", Type:=8)



    For Each cell In from
        cell.Copy
        For Each thing In too
            If thing.EntireRow.RowHeight > 0 Then
                thing.PasteSpecial
                Set too = thing.Offset(1).Resize(too.Rows.Count)
                Exit For
            End If
        Next
    Next


End Sub

享受！

Answer 4

我发现这很有效。它使用.autofilter对象的.range属性，这似乎是一个相当模糊但非常方便的功能：

Sub copyfiltered()
    ' Copies the visible columns
    ' and the selected rows in an autofilter
    '
    ' Assumes that the filter was previously applied
    '
    Dim wsIn As Worksheet
    Dim wsOut As Worksheet

    Set wsIn = Worksheets("Sheet1")
    Set wsOut = Worksheets("Sheet2")

    ' Hide the columns you don't want to copy
    wsIn.Range("B:B,D:D").EntireColumn.Hidden = True

    'Copy the filtered rows from wsIn and and paste in wsOut
    wsIn.AutoFilter.Range.Copy Destination:=wsOut.Range("A1")
End Sub

从过滤表的一列复制/粘贴/计算可见单元格

4 个答案: