10

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

我在 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))
4

4 回答 4

16

我在 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没有必要。

于 2013-07-08T16:49:30.810 回答
5

如果您需要更进一步，只需添加到 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 的评论，所以我必须作为新评论发布，抱歉。

于 2015-08-11T19:29:59.587 回答
2

这是适用于 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

享受！

于 2018-09-17T07:39:43.827 回答
0

我发现这很好用。它使用 .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
于 2017-12-05T06:03:53.023 回答