Sao chép/Dán/Tính toán các ô hiển thị từ một cột của bảng được lọc

Question

Tôi đang sử dụng AutoFilter để sắp xếp thông qua một bảng trong VBA, dẫn đến bảng dữ liệu nhỏ hơn. Tôi chỉ muốn sao chép/dán các ô hiển thị của một cột sau khi bộ lọc được áp dụng. Ngoài ra, tôi muốn trung bình các giá trị được lọc của một cột và đặt kết quả vào một ô khác.

Tôi đã tìm thấy đoạn mã này trên Stack cho phép tôi sao chép/dán toàn bộ kết quả hiển thị của bộ lọc, nhưng tôi không biết cách sửa đổi nó hoặc cách khác để chỉ nhận được giá trị của một cột tiêu đề) từ nó.

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

bổ sung trả lời (để tính toán với các giá trị lọc):

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

Answer 1

tôi thiết lập một loạt 3 cột đơn giản trên Sheet1 với quốc gia, thành phố, và ngôn ngữ trong cột A, B, và C. Đoạn mã sau tự động lọc phạm vi và sau đó chỉ dán một trong các cột dữ liệu được tự động lọc vào một trang tính khác. Bạn sẽ có thể sửa đổi này cho các mục đích của bạn:

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 

Lưu ý rằng bằng cách sử dụng cú pháp trên để sao chép và dán, không có gì được chọn hoặc kích hoạt (mà bạn nên luôn luôn tránh trong Excel VBA) và clipboard không phải là đã sử dụng. Kết quả là, Application.CutCopyMode = False là không cần thiết.

Answer 2

Chỉ cần thêm để mã hóa Jon nếu bạn cần mang nó một bước xa hơn, và làm nhiều hơn là chỉ một cột bạn có thể thêm một cái gì đó giống như

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") 

đặt những gần codings khác vốn là cùng bạn có thể dễ dàng thay đổi Ranges khi bạn cần.

Tôi chỉ thêm điều này vì nó hữu ích cho tôi. Tôi cho rằng Jon đã biết điều này nhưng đối với những người ít kinh nghiệm hơn thì đôi khi rất hữu ích khi xem cách thay đổi/thêm/sửa đổi các mã này. Tôi đã tìm ra từ khi Ruya không biết cách thao tác mã hóa ban đầu nó có thể hữu ích nếu bạn cần sao chép chỉ qua 2 cột hiển thị, hoặc chỉ 3, v.v. Bạn có thể sử dụng cùng mã này, thêm vào các dòng phụ gần như giống nhau và sau đó mã hóa được sao chép trên bất cứ điều gì bạn cần.

Tôi không có đủ danh tiếng để trả lời nhận xét của Jon trực tiếp nên tôi phải đăng bài làm bình luận mới, xin lỗi.

Answer 3

Tôi đã tìm thấy tính năng này hoạt động rất tốt. Nó sử dụng thuộc tính .range của đối tượng .autofilter, có vẻ hơi tối nghĩa, nhưng rất tiện dụng:

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