[VBA] - Recherche dans filtres - données visibles

Y compris Power BI, Power Query et toute autre question en lien avec Excel
L
Le Drosophile
Membre dévoué
Membre dévoué
Messages : 566
Appréciations reçues : 3
Inscrit le : 27 juin 2018
Version d'Excel : 2016

Message par Le Drosophile » 14 janvier 2020, 18:07

Bonsoir,

Dans mon document Excel, j'essaie de lancer une recherche d'un code, dans une base de données, en passant par des filtres pour accélérer la procédure.
Le problème, c'est que dans certains cas, j'ai des erreurs et je n'arrive pas bien à comprendre d'où cela provient.
SpoilerAfficher
J'ai une erreur "Dépassement de capacité" qui apparaît si j'utilise :
q = plage.SpecialCells(xlCellTypeVisible).Count
Et l'erreur "Pas de cellule correspondante " si j'utilise
Set plage = bdd.Range(.Cells(2, cib), .Cells(lrbdd, cib)).SpecialCells(xlCellTypeVisible)
q = plage.Count
Le mieux étant d'expliquer ce que je cherche à faire :

- Dans la feuille "Périmètres N2000"
- Enregistrer le numéro inscrit en [colonne B] (Exemple : FR9110108) [J'utilise ce code : Left(.Cells(i, 2), 9)]
- > L'utiliser pour filtrer la [colonne C] de la feuille "BDD "SPECIES"".
- En [colonne S] de la feuille "BDD "SPECIES"" ne s'afficheront que les "NOM" qu'il faut copier.
- Insérer le nombre de ligne correspondant au nombre de données copiées en [colonne C] de la feuille "Périmètres N2000"
- Coller ces "NOM" en [colonne C] de la feuille "Périmètres N2000"

- Recommencer pour le numéro suivant dans la feuille "Périmètres N2000".

Je joins un document via cjoin car il pèse 2Mo.
https://cjoint.com/c/JAorhka0PXB

Je vous remercie de votre attention.

Bonne soirée ! A plus tard :)
Modifié en dernier par Le Drosophile le 23 janvier 2020, 18:00, modifié 1 fois.
Avatar du membre
i20100
Passionné d'Excel
Passionné d'Excel
Messages : 5'713
Appréciations reçues : 333
Inscrit le : 16 mars 2017
Version d'Excel : 2010

Message par i20100 » 15 janvier 2020, 09:28

Bonjour,

j'ai transformé les données de la base en tableau,
par expérience je trouve que c'est la solution la plus fiable pour récolter les données filtrées
j'ai ajouté un onglet "tempo" pour récolter les données filtrées
et transférer le résultat final sur l'onglet "résultat"
j'ai aussi réduit le nombre de ligne de la base pour pour réduire le fichier à moins de 1000 ko
à tester,
Le Drosophile-Erreur-recherche-data.xlsm
(959.74 Kio) Téléchargé 6 fois
1 membre du forum aime ce message.
Vive ces nouvelles saisons qui nous colorent.
isabelle
L
Le Drosophile
Membre dévoué
Membre dévoué
Messages : 566
Appréciations reçues : 3
Inscrit le : 27 juin 2018
Version d'Excel : 2016

Message par Le Drosophile » 15 janvier 2020, 14:47

Bonjour,

Je vous remercie pour votre réponse.

Votre code fonctionne, mais j'aimerais faire en sorte qu'il ne travaille que sur une feuille si possible.

Mon unique problème (pour le moment, a priori) c'est que je ne parviens pas à lui faire compter le nombre de lignes filtrées visibles. Soit il m'indique 0, soit un chiffre qui n'est pas le bon (19 en l'occurrence... ; alors qu'1 seule ligne est visible, hors en-tête).

J'ai utilisé ces codes ci :
           lrbdd = bdd.Cells(bdd.Rows.Count, 1).End(xlCellTypeVisible).Row '=> 0
           lrbdd = bdd.SpecialCells(xlCellTypeVisible).Count / 19 ' => Erreur
           lrbdd = bdd.ListObjects("Tab_spec").SpecialCells(xlCellTypeVisible).Count '=> 0
           lrbdd = bdd.ListObjects("Tab_spec").Count '=> 0

    Dim NoLigne(), t, j, a
    Dim ligne As Variant
        For Each ligne In bdd.ListObjects("Tab_spec").DataBodyRange.SpecialCells(xlCellTypeVisible) 'bdd.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows
            t = t + 1
            ReDim Preserve NoLigne(t)
            NoLigne(t) = ligne.Address(RowAbsolute:=False, ColumnAbsolute:=False)
        Next 
'=> 19
Comment puis-je faire pour qu'Excel compte le nombre de cellules visibles ?
Exactement comme il le fait lorsque je sélectionne une colonne et qu'il affiche dans le bandeau du bas : Nb (non vides) : x)

Bonne journée !
Avatar du membre
i20100
Passionné d'Excel
Passionné d'Excel
Messages : 5'713
Appréciations reçues : 333
Inscrit le : 16 mars 2017
Version d'Excel : 2010

Message par i20100 » 15 janvier 2020, 19:00

Le Drosophile a écrit :
15 janvier 2020, 14:47
Comment puis-je faire pour qu'Excel compte le nombre de cellules visibles ?
Exactement comme il le fait lorsque je sélectionne une colonne et qu'il affiche dans le bandeau du bas : Nb (non vides) : x)
re,

tu pourrais utiliser la fonction Sous.Total
n = Application.Subtotal(2, Range("A:A"))
1 membre du forum aime ce message.
Vive ces nouvelles saisons qui nous colorent.
isabelle
L
Le Drosophile
Membre dévoué
Membre dévoué
Messages : 566
Appréciations reçues : 3
Inscrit le : 27 juin 2018
Version d'Excel : 2016

Message par Le Drosophile » 15 janvier 2020, 23:11

Bonsoir,

Merci pour votre réponse, cela m'a débloqué dans mon problème, mais hélas je n'ai pas réussi à faire ce que j'espérais.
Le code dont il est question est le suivant :
SpoilerAfficher
Sub Compdatapnsps()
Dim temp As Worksheet, rs As Worksheet
Dim code As String, rw1&, rw2&, lrbdd&
Dim plg As Range

Set pn = Worksheets("Périmètres N2000")
Set bdd = Worksheets("BDD ""SPECIES""")

lrpn = pn.Cells(pn.Rows.Count, 2).End(xlUp).Row
cib = bdd.Rows("1:1").Find("NOM", LookIn:=xlValues, Lookat:=xlWhole).Column

With bdd
    For i = lrpn To 2 Step -1
        code = Left(pn.Cells(i, 2), 9)
        .ListObjects("Tab_spec").Range.AutoFilter Field:=3, Criteria1:="=" & code, Operator:=xlAnd
        'On Error Resume Next
                .Activate
                lrbdd = Application.Subtotal(3, Range("S:S"))
            
                'Insérer le nombre de lignes adéquat
                pn.Activate
                    If lrbdd > 1 Then
                        pn.Cells(i, 1).Resize(lrbdd - 2, 1).EntireRow.Insert
                        'Set rng = .Range(.Cells(2, cib), .Cells(lrbdd, cib))
                        'Set rng = .Cells(2, cib).SpecialCells(xlCellTypeVisible)
                        Set rng = bdd.ListObjects("Tab_spec").Application.Subtotal(3, Range("S:S")) '.SpecialCells(xlCellTypeVisible)
                        rng.Copy Destination:=pn.Cells(i, 3)
                    Else
                        pn.Cells(i, 3) = "Non concerné"
                    End If
    Next i
End With
End Sub
Et mon erreur se situe là :
                        'Set rng = .Range(.Cells(2, cib), .Cells(lrbdd, cib))
                        'Set rng = .Cells(2, cib).SpecialCells(xlCellTypeVisible)
                        Set rng = bdd.ListObjects("Tab_spec").Application.Subtotal(3, Range("S:S")) 
A nouveau, je n'arrive pas à faire comprendre à Excel que je veux copier les données visibles présentes en colonne S.
Il me copie un peu n'importe quoi, même des données issues d'une autre page que "bdd" ::o

Je vais essayer s'adapter votre méthode à ce code ci, ces prochains jours, et reviendrai poster le resultat s'il fonctionne..

Bonne soirée !
Avatar du membre
eriiic
Passionné d'Excel
Passionné d'Excel
Messages : 9'357
Appréciations reçues : 397
Inscrit le : 7 février 2010
Version d'Excel : 2010fr

Message par eriiic » 16 janvier 2020, 00:52

Bonjour à tous,

.SubTotal retourne un nombre, pas un range. Tu ne peux pas l'affecter avec Set (reservé aux objets, comme un Range)
C'est une bonne solution pour ton pb.

Cependant je vais t'expliquer tes erreurs avec SpecialCells, pour une prochaine fois...
- SpecialCells génère une erreur si rien n'est trouvé, il faut la gérer
- la plage résultante peut être fragmentée. Tu ne peux donc pas avoir directement le nombre de lignes, il faut compter celles de chaque area.
Ce qui donne :
Dim pl As Range, ar As Range, nblig As Long

            ' tes filtres...
            '
            Set pl = Nothing: nblig = 0
            On Error Resume Next
            Set pl = bdd.Cells.Resize(bdd.Cells(bdd.Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not pl Is Nothing Then
                For Each ar In pl.Areas
                    nblig = nblig + ar.Rows.Count
                Next ar
            End If
            MsgBox nblig ' & " lignes : " & pl.address
eric
En essayant continuellement, on finit par réussir.
Donc plus ça rate, plus on a de chances que ça marche.
(les Shadoks)

En plus du merci (si si, ça se fait !!!), penser à mettre en résolu. Merci
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'386
Appréciations reçues : 670
Inscrit le : 27 août 2012
Version d'Excel : 365 Personnel

Message par Jean-Eric » 16 janvier 2020, 01:08

Bonjour,
Bonjour Eriiic,
Pour commencer mes meilleurs vœux pour cette nouvelle année.
Je pense que ceci est fonctionnel ?
On Error Resume Next
Set pl = bdd.Cells.Resize(bdd.Cells(bdd.Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
n = pl.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
On Error GoTo 0
Cdlt.
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
L
Le Drosophile
Membre dévoué
Membre dévoué
Messages : 566
Appréciations reçues : 3
Inscrit le : 27 juin 2018
Version d'Excel : 2016

Message par Le Drosophile » 16 janvier 2020, 15:16

Bonjour,

Concernant le code :
            Set pl = Nothing: nblig = 0
            On Error Resume Next
            Set pl = bdd.Cells.Resize(bdd.Cells(bdd.Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not pl Is Nothing Then
                For Each ar In pl.Areas
                    nblig = nblig + ar.Rows.Count
                Next ar
            End If
nblig = le bon nombre de lignes (il prend en compte la première ligne, à retirer ensuite)

En revanche,
n = pl.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
n = 0 ; il ne semble pas compter le nombre de ligne (= 0 avec ou sans -1).

Mais finalement,
lrbdd = Application.Subtotal(3, Range("S:S"))
fait très bien le travail, puisqu'il semble également compter le bon nombre de lignes.

C'est ensuite, lorsque je cherche à copier la plage visible (de 2 à "dernière ligne visible") que ça ne marche pas.

Je n'ai pas encore fait les tests en remixant avec le précédent code de i20100.

A plus tard !
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'386
Appréciations reçues : 670
Inscrit le : 27 août 2012
Version d'Excel : 365 Personnel

Message par Jean-Eric » 16 janvier 2020, 15:37

Bonjour,
Un exemple fonctionnel pour compter le nombre de cellules filtrées.
Cdlt.
Nombre de lignes visibles filtre vba.xlsm
(18.58 Kio) Téléchargé 2 fois
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lo As ListObject, Rng As Range, n As Long
    If Target.Address = "$D$3" Then
        Set lo = Range("Data").ListObject
        lo.Range.AutoFilter field:=1, Criteria1:=Target.Value
        Set Rng = lo.AutoFilter.Range
        'On Error Resume Next
        MsgBox Rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 _
               & " of " & Rng.Rows.Count - 1 & " Enregistrements"
        'On Error GoTo 0
        lo.Range.AutoFilter field:=1
    End If
End Sub
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
L
Le Drosophile
Membre dévoué
Membre dévoué
Messages : 566
Appréciations reçues : 3
Inscrit le : 27 juin 2018
Version d'Excel : 2016

Message par Le Drosophile » 16 janvier 2020, 15:43

Re,

Un code qui fonctionne quasiment :
Dim temp As Worksheet, rs As Worksheet
Dim code As String, rw1&, rw2&, lrbdd&
Dim plg As Range, plg1 As Range

Set pn = Worksheets("Périmètres N2000")
Set bdd = Worksheets("BDD ""SPECIES""")

lrpn = pn.Cells(pn.Rows.Count, 2).End(xlUp).Row
cib = bdd.Rows("1:1").Find("NOM", LookIn:=xlValues, Lookat:=xlWhole).Column

With bdd
    For i = lrpn To 2 Step -1
        code = Left(pn.Cells(i, 2), 9)
        .ListObjects("Tab_spec").Range.AutoFilter Field:=3, Criteria1:="=" & code, Operator:=xlAnd
        .Activate
        On Error Resume Next
        Set plg = .ListObjects("Tab_spec").DataBodyRange.SpecialCells(xlCellTypeVisible)
        'If Err.Number <> 0 Then GoTo 0
        On Error Resume Next
        lrbdd = Application.Subtotal(3, Range("S:S")) - 1
            
                'Insérer le nombre de lignes adéquat
                pn.Activate
                    If lrbdd > 0 Then
                        pn.Cells(i, 1).Resize(lrbdd - 1, 1).EntireRow.Insert
                        plg.Columns(19).Copy pn.Cells(i, 3)
                    Else
                        pn.Cells(i, 3) = "Non concerné"
                    End If
                    
    Next i

'suivant:
 
End With
End Sub
Il reste un problème avec Set plg = .ListObjects("Tab_spec").DataBodyRange.SpecialCells(xlCellTypeVisible)
La plage fait parfois le bon nombre de lignes et parfois pas... donc si je copie la plage, je ne copie que "x" lignes du tableaux, pas toutes celles affichées. Comme si Excel ne "voyait" pas certaines lignes, qui sont bel et bien visibles.

Je regarde votre document de suite. :)
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message