Kopieren/Einfügen/Berechnen von sichtbaren Zellen aus einer Spalte einer gefilterten Tabelle

Question

Ich verwende AutoFilter, um eine Tabelle in VBA zu sortieren, was zu einer kleineren Datentabelle führt. Ich möchte nur die sichtbaren Zellen einer Spalte kopieren/einfügen, nachdem der Filter angewendet wurde. Außerdem möchte ich die gefilterten Werte einer Spalte mitteln und das Ergebnis in eine andere Zelle setzen.

Ich habe dieses Snippet auf Stack gefunden, das mir erlaubt, die gesamten sichtbaren Ergebnisse des Filters zu kopieren/einfügen, aber ich weiß nicht, wie man es verändert oder einen anderen Weg, um nur eine Spalte von Daten zu erhalten der Header) von ihm.

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

Zusatz zu beantworten (mit den gefilterten Werten zu berechnen):

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

Answer 1

ich einen einfachen 3-Spalten-Bereich in Sheet1 mit Land, Stadt und Sprache in den Spalten A einrichten, B und C. Der folgende Code filtert automatisch den Bereich und fügt dann nur eine der Spalten der automatisch gefilterten Daten in ein anderes Blatt ein. Sie sollten dies für Ihre Zwecke ändern können,:

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 

Beachten Sie, dass die Syntax oben unter Verwendung zum Kopieren und Einfügen, nichts ausgewählt oder aktiviert wird (die Sie immer in Excel VBA vermeiden sollte) und die Zwischenablage ist nicht benutzt. Daher ist Application.CutCopyMode = False nicht erforderlich.

Answer 2

Nur um Jons Codierung hinzufügen, wenn Sie noch einen Schritt weiter gehen benötigt, und mehr tun, als nur eine Spalte, die Sie so etwas wie

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

setzen diese in der Nähe der anderen Kodierungen hinzufügen können, die gleich sind Sie kann die Bereiche leicht ändern, wie Sie benötigen.

Ich füge nur hinzu, weil es für mich hilfreich war. Ich nehme an, dass Jon das bereits weiß, aber für diejenigen, die weniger erfahren sind, ist es manchmal hilfreich zu sehen, wie man diese Kodierungen ändert/hinzufügt/modifiziert. Ich dachte, da Ruya nicht wusste, wie man die ursprüngliche Kodierung manipuliert, könnte es hilfreich sein, wenn man nur 2 sichtbare Spalten oder nur 3 usw. kopieren müsste. Man kann diese Kodierung verwenden, indem man zusätzliche Zeilen hinzufügt das gleiche und dann die Codierung kopiert über was auch immer Sie brauchen.

Ich habe nicht genug Reputation, um direkt auf Jons Kommentar zu antworten, also muss ich als neuen Kommentar posten, sorry.

Answer 3

Ich habe gefunden, dass dies sehr gut funktioniert. Es nutzt die .Range Eigenschaft des .autofilter-Objekt, das eine ziemlich dunkel, aber sehr praktisch zu sein scheint, Eigenschaft:

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