VBA sélection de cellules visibles après filtrage

Le code suivant applique des filtres et sélectionne le top 10 des éléments de la colonne B, après quelques filtres sont appliqués à la table. J'ai été en utilisant ce pour de nombreuses filtré de la sélection, mais je suis tombé sur un problème avec un de mes combinaisons de filtres.

J'ai constaté que quand il n'y a qu'un seul élément dans la colonne B, après filtrage, il ne copie pas qu'une cellule - à la place, il copie l'intégralité de la ligne et semble être un étrange sélection.

Quand j'ai ajouter manuellement un élément de plus à ce que le filtre (total 2), puis il le copie fine. Toutes les idées sur pourquoi ce code ne fonctionne pas quand il y a un seul élément?

Sub top10()

Dim r As Range, rC As Range
Dim j As Long

'Drinks top 10
Worksheets("OLD_Master").Columns("A:H").Select
Selection.sort Key1:=Range("H1"), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

Worksheets("OLD_Master").Range("A:H").AutoFilter Field:=4, Criteria1:=Array(     _
    "CMI*"), Operator:= _
    xlFilterValues
Worksheets("OLD_Master").Range("A:H").AutoFilter Field:=5,   Criteria1:="Drinks"

Set r = Nothing
Set rC = Nothing
j = 0

Set r = Range("B2", Range("B" &     Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

For Each rC In r
    j = j + 1
    If j = 10 Or j = r.Count Then Exit For
Next rC

Range(r(1), rC).SpecialCells(xlCellTypeVisible).Copy

Worksheets("For Slides").Range("P29").PasteSpecial
Worksheets("OLD_Master").ShowAllData

End Sub

Vous utilisez un PasteSpecial, mais où voulez-vous réel de faire la copie?
Si vous appliquez Specialcells à une seule cellule, il s'applique en fait à l'ensemble de la plage utilisée de la feuille. Vous devez tester le comte avant de l'utiliser.
Désolé à ce sujet - j'ai été le tester avec "select" à la place de la copie. Je l'ai changé maintenant

InformationsquelleAutor wra | 2017-03-28

2

Rory utilement souligne:

Si vous appliquez Specialcells à une seule cellule, il s'applique en fait à l'ensemble de la plage utilisée de la feuille.

Maintenant, nous savons quel est le problème, on peut l'éviter! La ligne de code où vous utilisez SpecialCells:
```
Set r = Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
```
Au lieu de cela, définissez la plage d'abord, tester si elle ne contient qu'une seule cellule, puis de procéder...
```
Set r = Range("B2", Range("B" & Rows.Count).End(xlUp))
' Check if r is only 1 cell
If r.Count = 1 Then
    r.Copy
Else ' Your previous code
    Set r = r.SpecialCells(xlCellTypeVisible)
    For Each rC In r
        j = j + 1
        If j = 10 Or j = r.Count Then Exit For
    Next rC
    Range(r(1), rC).SpecialCells(xlCellTypeVisible).Copy
End If
```
Remarque, vous êtes en supposant qu'il en est de même un ligne est toujours visible. Il se pourrait que le .End(xlUp) sélectionne la ligne 1 s'il n'existe pas de données visibles, vous voudrez peut-être vérifier que les lignes qui c'est d'abord trop!

De côté: Vous devriez vraiment être entièrement admissible vos gammes, c'est à dire au lieu de
```
 Set r = Range("B2")
```
Vous devez utiliser
```
Set r = ThisWorkbook.Sheets("MySheet").Range("B2")
```
Cela vous fera économiser de confusion erreurs à l'avenir. Il y a des raccourcis, vous pouvez prendre, par exemple, sauver la répétition à l'aide de With de blocs ou de déclarer les objets de la feuille.
```
' using With blocks
With ThisWorkbook.Sheets("MySheet")
    Set r = .Range("B2")
    Set s = .Range("B3")
    ' ...
End With

' Using sheet objects
Dim sh as Worksheet
Set sh = ThisWorkbook.Sheets("MySheet")
Set r = sh.Range("B2")
```
- J'ai eu la même idée! Merci!!!! Vous plus élégantes et je vais pour pour que. Reconnaissant de toute l'aide!
- Pas de soucis, si cela convient à vos besoins, alors envisager de marquer ce que l'on a accepté la réponse! 🙂
- Merci pour les conseils!!! Encore assez nouveau pour cette et apprécier les conseils!
InformationsquelleAutor Wolfie

Merci à @Rory

Specialcells

Ne fonctionne pas avec une cellule sélectionnée. Adapté de la manière suivante:

......

For Each rC In r
    j = j + 1
    If j = 10 Or j = r.Count Then Exit For
Next rC

If j = 1 Then
    Range(r(1), rC).Copy
Else
    Range(r(1), rC).SpecialCells(xlCellTypeVisible).Select
End If

Worksheets("For Slides").Range("P29").PasteSpecial
Worksheets("OLD_Master").ShowAllData

End Sub

ne pourrait-il pas être: Range(r(1), rC).SpecialCells(xlCellTypeVisible).Copy?

InformationsquelleAutor wra

Vous devez vous connecter pour publier un commentaire.