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

Question

我正在使用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))

Answer 1

我在Sheet1上使用Country,City和Language在A,B和C列中设置了一个简单的3列范围.以下代码自动过滤范围,然后仅将其中一列自动过滤数据粘贴到另一个工作表.您应该可以为此目的修改此内容:

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的评论，所以我不得不发表新评论，对不起。