web-dev-qa-db-fra.com

Copier/coller/calculer des cellules visibles à partir d'une colonne d'un tableau filtré

J'utilise AutoFilter pour trier une table dans VBA, ce qui donne une table de données plus petite. Je veux seulement copier/coller les cellules visibles d'une colonne après l'application du filtre. De plus, j'aimerais faire la moyenne des valeurs filtrées d'une colonne et placer le résultat dans une cellule différente.

J'ai trouvé cet extrait sur Stack qui me permet de copier/coller l'intégralité des résultats visibles du filtre, mais je ne sais pas comment le modifier ni utiliser un autre moyen d'obtenir des données d'une seule colonne (sans l'en-tête) il.

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

Ajout pour répondre (à calculer avec les valeurs filtrées): 

tgt.Range("B2").Value =WorksheetFunction.Average(copyRange.SpecialCells(xlCellTypeVisible))
excel-vbafiltercopy-pastevbaexcel
8
ruya

J'ai configuré une plage simple de 3 colonnes sur la feuille Sheet1 avec Country, City et Language dans les colonnes A, B et C. Le code suivant filtre automatiquement la plage, puis ne colle qu'une seule des colonnes de données filtrées automatiquement dans une autre feuille. Vous devriez pouvoir modifier ceci pour vos besoins:

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

Notez qu'en utilisant la syntaxe ci-dessus pour copier et coller, rien n'est sélectionné ou activé (ce que vous devez toujours éviter dans Excel VBA) et le presse-papiers n'est pas utilisé. En conséquence, Application.CutCopyMode = False n'est pas nécessaire.

13
Jon Crowell

Juste pour ajouter au code de Jon si vous deviez aller plus loin et faire plus qu’une colonne, vous pouvez ajouter quelque chose comme: 

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

placez-les près des autres codages identiques, vous pouvez facilement modifier les plages selon vos besoins. 

J'ajoute seulement cela parce que cela m'a été utile. Je suppose que Jon le sait déjà, mais pour ceux qui ont moins d'expérience, il est parfois utile de voir comment changer/ajouter/modifier ces codages. Puisque Ruya ne savait pas manipuler le code d'origine, je pensais qu'il pourrait être utile de ne copier que deux colonnes visibles, ou seulement trois, etc. Vous pouvez utiliser le même code, ajouter des lignes supplémentaires presque la même chose et le codage copie tout ce dont vous avez besoin. 

Je n'ai pas assez de réputation pour répondre directement au commentaire de Jon, je suis donc obligé de le publier en tant que nouveau commentaire, désolé. 

4
MadChadders

Voici un code qui fonctionne avec windows office 2010 . Ce script vous demandera une plage de cellules filtrée en entrée, puis une plage de collage. 

S'il vous plaît, les deux plages devraient avoir le même nombre de cellules.

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

Prendre plaisir!

1
Joniale

J'ai trouvé que cela fonctionne très bien. Il utilise la propriété .range de l'objet .autofilter, qui semble être une fonctionnalité plutôt obscure, mais très pratique:

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
0
Johnny D