Selection dans tableau filtrée

Version imprimable

Bonjour à tous,

Un exemple tout simple de mon problème. Dans un onglet, commençant en A1, le tableau ci-dessous :

Prénom Nom Ville

Lana Cally Marseille

Liberty Virginia Paris

Mara Gareth Lyon

Adele Rudyard Paris

Hedley Ezra Paris

Beck Liberty Lyon

Valentine Abdul Montpellier

William Kylan Lyon

Orli Kelly Lyon

Lamar Lucas Paris

Yen Jennifer Montpellier

Le code ci-dessous me sélectionne bien la première ligne filtrée mais pas la seconde :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub Macro1() Dim O As Object 'déclare la variable O (Onglet) Dim DL As Integer 'déclare la variable DL (Dernière Ligne) Dim PL As Range 'déclare la variable PL (PLage) Dim PLV As Range 'déclare la variable PLV (PLage Visible) Set O = Sheets("Feuil1") 'définit l'onglet O DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O Set PL = O.Range("A2:A" & DL) 'définit la plage PL O.Range("A1").AutoFilter Field:=3, Criteria1:="Montpellier" 'filtre l'onglet O sur les villes avec "Montpellier" comme critère Set PLV = PL.SpecialCells(xlCellTypeVisible) 'définit la plage PLV PLV.Cells(1, 1).Select 'sélectionne bien la cellule ligne 1, colonne 1 de PLV soit A8 PLV.Cells(2, 1).Select 'sélectionne A9 et non pas A12 comme j'aurais souhaité ? End Sub
L'avant dernière ligne du code ne fonctionne pas comme je l'aurais souhaité. Quelqu'un aurait-il la méthode/solution pour y parvenir ?

Bonjour,

en bricolant avec des area on peut s'en sortir sur des cas simples, mais pour généraliser il faudrait une fonction je pense
ou une méthode moins "force brute"

Appliqué à ton cas précis de jeux de données, ceci fonctionne
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Sub Macro1() Dim O As Object 'déclare la variable O (Onglet) Dim Plage As Range Set O = Sheets("Feuil1") 'définit l'onglet O With O .Range("A1").AutoFilter Field:=3, Criteria1:="Montpellier" 'filtre l'onglet O sur les villes avec "Montpellier" comme critère Set Plage = .UsedRange.SpecialCells(xlCellTypeVisible) End With MsgBox Plage.Address With Plage If O.Rows(2).Hidden = False Then MsgBox .Areas(1).Cells(2, 1).Address MsgBox .Areas(2).Cells(1, 1).Address Else MsgBox .Areas(2).Cells(1, 1).Address MsgBox .Areas(3).Cells(1, 1).Address End If End With End Sub
Seule le cas où "premier ligne est masqué" est géré
je n'ai pas géré le cas où les deux premières lignes issues du filtre sont contigües

Salut !

Robert, dans le même genre de Joe pour sélectionner uniquement la deuxième occurrence :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Demo1()
    Const N = 2
    Dim Rg As Range
 
    With Feuil1
        If .FilterMode Then .ShowAllData
 
        With .Cells(1).CurrentRegion.Columns(3).Rows
             .AutoFilter 1, "Montpellier"
 
            If Application.Subtotal(103, .Cells) > 1 Then
                With .Item("2:" & .Count)
                    For Each Rg In .SpecialCells(xlCellTypeVisible).Areas
                        If Rg.Count + C& >= N Then Rg.Cells(N - C).Select: Exit For
                        C = C + Rg.Count
                    Next
                End With
            End If
 
            .AutoFilter
        End With
    End With
End Sub

Sinon pour sélectionner toutes les occurrences :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Demo2()
    Const N = 2
    Dim Rg As Range
 
    With Feuil1
        If .FilterMode Then .ShowAllData
 
        With .Cells(1).CurrentRegion.Columns(3).Rows
             .AutoFilter 1, "Montpellier"
            If Application.Subtotal(103, .Cells) > 1 Then .Item("2:" & .Count).SpecialCells(xlCellTypeVisible).Select
            .AutoFilter
        End With
    End With
End Sub

_____________________________________________________________________________________________________

Je suis Charlie, Bardo, Sousse

Bravo Marc-L, je butais sur le problème de généralisation des cas et ta méthode est ultra optimisée

je me suis donc amusé à transformer ça en procédure, et j'espère bien que tu vas me la massacrer :aie:
j'arrive pas à diminuer le nombre d'arguments

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub SelectTest()
    Call Demo1(2, Feuil1, "Paris", Feuil1.Cells(1, 3))
End Sub
 
Sub Demo1(EltNumber, Sh As Worksheet, _
          Critere As String, Optional Pos As Range)
 
'EltNumber : le Xème élément à sélectionner
'Sh        : la feuille de travail
'Critère   : critère du filtre
'Pos       : la cellule où on met le filtre (A1 par défaut)
 
    Dim Rg As Range
 
    With Sh
        If Pos Is Nothing Then Set Pos = .Cells(1, 1)
        If .FilterMode Then .ShowAllData
 
        With .Cells(Pos.Row).CurrentRegion.Columns(Pos.Column).Rows
             .AutoFilter 1, Critere
 
            If Application.Subtotal(103, .Cells) > 1 Then
                With .Item(Pos.Row + 1 & ":" & .Count)
                    For Each Rg In .SpecialCells(xlCellTypeVisible).Areas
                        If Rg.Count + C& >= EltNumber Then
                            Rg.Cells(EltNumber - C).Select
                            Exit For
                        Else
                            C = C + Rg.Count
                        End If
                    Next
                    .AutoFilter
                End With
            End If
        End With
    End With
End Sub

je laisse le plaisir à qui le voudra de mettre les deux messages d'alerte :

- pas de résultat pour le filtre
- on veut le Xème élément mais il n'y en a pas assez

un petit booléen bien placé suffit

Merci Joe !
Pour diminuer le nombre d'argument, tu peux imposer alors le Range source, plus besoin d'un argument pour la feuille …

Mes procédures Demo1 & 2 ne fonctionnent que si Feuil1 est déjà active …

Voici une fonction alimentant une variable tableau des valeurs filtrées et de leurs adresses :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Function FilterColumnArray(Rcol As Range, CRITERIA$)
            Dim Rc As Range, Rg As Range
         FilterColumnArray = Split("")
    If Rcol.Columns.Count > 1 Then Exit Function
    Application.ScreenUpdating = False
 
    With Rcol.Rows
        .AutoFilter
        .AutoFilter 1, CRITERIA
           L& = Application.Subtotal(103, .Cells) - 1
        If L Then
                ReDim AR(1 To L, 1 To 2)
            For Each Rg In .Item("2:" & .Count).SpecialCells(xlCellTypeVisible).Areas
                For Each Rc In Rg
                          R& = R& + 1
                    AR(R, 1) = Rc.Value
                    AR(R, 2) = Rc.Address
                Next
            Next
                FilterColumnArray = AR
        End If
            .AutoFilter
    End With
End Function
 
Sub Demo3()
    With Feuil1
        VF = FilterColumnArray(.Cells(1).CurrentRegion.Columns(3), "Montpellier")
        If UBound(VF) >= 2 Then .Activate: .Range(VF(2, 2)).Select
    End With
End Sub

Mais s'il est juste question de sélectionner la n-ième cellule d'une colonne correspondant à un critère,
pas la peine de gâcher des ressources ni de filtrer, la méthode Find s'en acquitte très bien !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub FindSelect(ByVal Rg As Range, WHAT, Optional ORDER% = 1)
                 Dim Rf As Range
    With Rg
           Set Rf = .Find(WHAT, .Cells(.Cells.Count), xlValues, xlWhole, xlByColumns, xlNext)
        If Not Rf Is Nothing Then
                      AD$ = Rf.Address
            Do
                       N% = N% + 1:  If N = ORDER Then Exit Do
                   Set Rf = .FindNext(Rf)
            Loop Until Rf.Address = AD
 
              If N = ORDER Then Rf.Parent.Activate: Rf.Select
            Set Rf = Nothing
        End If
    End With
            Set Rg = Nothing
End Sub
 
Sub Demo4()
    FindSelect Feuil1.Cells(1).CurrentRegion.Columns(3), "Montpellier", 2
End Sub

_____________________________________________________________________________________________________

Découvrir, c’est voir la même chose que les autres et penser autrement. (Albert von Szent-Györgyi)

08/08/2015, 15h24
Docmarti
Citation:

Envoyé par Thautheme

Le code ci-dessous me sélectionne bien la première ligne filtrée mais pas la seconde :

Peut-être ceci, vu que PL et PLV contiennent seulement une colonne.
Code:

1 2 3 4 5 6 MsgBox PLV.Address For Each cl In PLV.Cells Debug.Print cl Next
09/08/2015, 13h27
Thautheme

Bonjour le fil, bonjour le forum,

Encore une fois merci à tous. J'aurais dû expliquer quel était le but de ce code.
J'ai plusieurs fois rencontré des demandeurs qui voulaient grouper plusieurs lignes contenant le même code (par exemple) en une seule mais en faisant les sommes sur des valeurs. Puis à la fin en supprimant les lignes inutiles.
Le filtre me permettait d'afficher toute les ligne du même code. Mais ensuite je voulais boucler sur toutes ces lignes filtrées pour effectuer les calculs, tout reporter dans la première ligne et ensuite effacer toutes les lignes à partir de la seconde...

Du coup, le Subtotal de Marc semblait bien convenir. Mais quand j'ai vu les explications fournies dans l'aide VBA j'ai pleuré ma mère... Et comme je n'aime utiliser que les choses que je comprends, j'ai laissé tomber... (oui je sais, ça me limite beaucoup du coup !...)
Il est vrai aussi Marc qu'avec les fonctions Find et FindNext je peux obtenir la même chose sans même prendre la peine de filtrer...
La solution de Joe de m'envoyer en l'aire me permet aussi d'obtenir les numéros de ligne de la plage filtrée pour pouvoir y travailler dessus
Ou comme le propose Docmarti Stocker le numéro de ligne avec Juste un For Each CEL in PLV...
Toutes vos propositions m'e permettent d'envisager de différentes manières ce problème et d'utiliser celle qui me semblera le mieux adapter le cas venu.

Merci encore. Sujet clos.
09/08/2015, 14h41
Marc-L

Salut Robert et merci !

En fait la méthode VBA Subtotal correspond à la fonction de feuille de calculs SOUS.TOTAL,
l'aide d'Excel peut t'éclaircir quant à son utilisation … Elle n'est pas difficile et peut s'avérer fort utile !
09/08/2015, 17h41
Thautheme

Re,

En effet Marc, l'aide Excel est bien plus claire que l'aide VBA... Merci du tuyau.

Prénom	Nom	Ville
Lana	Cally	Marseille
Liberty	Virginia	Paris
Mara	Gareth	Lyon
Adele	Rudyard	Paris
Hedley	Ezra	Paris
Beck	Liberty	Lyon
Valentine	Abdul	Montpellier
William	Kylan	Lyon
Orli	Kelly	Lyon
Lamar	Lucas	Paris
Yen	Jennifer	Montpellier