Boucle sur les critères d'un filtre

[ioan44]

Bonjour a tous,

Je viens vers vous car mes autres recherche on été vaines. Je cherche à créer une boucle qui me permettrais d'effectuer une action ( ici copier le tableau affiché ) d'apres chaque critere du filtre et ce quel qu'il soit.

En plus clair peut etre il faudrait que la boucle selectionne le critere 1 et copie le tableau trié, puis selectionne le critere 2 et copie le tableau trié, etc jusqu'au dernier critere tous en sachant que les critères peuvent varié en nom et en nombre.

Je vous transmet le tableau qui sert de base ( il sagit d'une extraction d'une base de donnée donc quelques soit les valeurs l'architecture ne changera jamais d'une extraction a l'autre), je souhaite effectuer le tri sur la liste des equipe en colonne J.

Petite précision les actions a mener dans la boucle ne me pose aucun soucis; la boucle seule me fait perdre mes cheveux.

J'avais pense a quelque chose genre:

ForEach 'critere du champ 10'

.copie de mon tableau

Next


Merci a tous.

 

[jp14]

Re : Boucle sur les critères d'un filtre

Bonjour

Ci dessous un code à tester puis à modifier

For Each cellule In Range("j2:j" & Range("j65536").End(xlUp).Row).SpecialCells(xlVisible)
Sheets("Feuil2").Range("a" & li) = cellule.Offset(0, -2)
li = li + 1
Next cellule


JP

 

[Paf]

Re : Boucle sur les critères d'un filtre

Bonjour à tous,

En plus clair peut etre il faudrait que la boucle selectionne le critere 1 et copie le tableau trié, puis selectionne le critere 2 et copie le tableau trié, etc jusqu'au dernier critere tous en sachant que les critères peuvent varié en nom et en nombre.

Si j'ai bien compris, cela revient à copier l'ensemble du tableau trié selon la colonne J ?

A+

 

[Robert]

Re : Boucle sur les critères d'un filtre

Bonjour le fil, bonjour le forum,

Une autre proposition. Le tableau est d'abord trié puis chaque secteur copier dans l'onglet Feuil2. les tableaux sont séparées par une ligne vide...
Le code commenté :

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 col As Range 'déclare la variable col (COLonne)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim d As Object 'déclare la variable d (Dictionnaire)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim tmp As Variant 'déclare la variable tmp (tableau TeMPoraire)

Set o = Sheets("Feuil1") 'définit l'onglet o
'tri alphabétique reçupéré par l'enregistreur de macro
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("J2:J60"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").Sort
    .SetRange Range("A1:M60")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
dl = o.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A)
Set pl = o.Range("A1:M" & dl) 'définit la plage pl
Set col = o.Range("J2:J" & dl) 'définit la colonne col
Set d = CreateObject("Scripting.Dictionary") 'définit le dictionanire d
For Each cel In col 'boucle sur toutes les cellules cel de la colonne col
    d(cel.Value) = "" 'alimente le dictionnaire
Next cel 'prochaine cellule de la boucle
tmp = d.keys 'récupère les valeurs uniques (sans doublons) de la colonne col dans le tableau tmp
For i = 0 To UBound(tmp, 1) 'boucle sur toutes les valeurs uniques du tableau tmp
    'définit la cellule des destination (à adapter à ton cas)
    With Sheets("Feuil2") 'prend en compte l'onglet "Feuil2"
        'définit la destination (A1 si A1 est vide, sinon la seconde cellule vide rencontrée en colonne A)
        Set dest = IIf(.Range("A1").Value = "", .Range("A1"), .Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0))
    End With 'fin de la prise en compte de l'onglet "Feuil2"
    o.Range("A1").AutoFilter Field:=10, Criteria1:=tmp(i) 'filtre par rapport à la valeur uniqie tmp(i)
    pl.SpecialCells(xlCellTypeVisible).Copy dest 'copie les cellules visible de la plage pl et les colle dans dest
    o.Range("A1").AutoFilter 'supprime le filtre automatique
Next i 'prochaine valeur inique de la boucle
End Sub

 

[ioan44]

Re : Boucle sur les critères d'un filtre

rebonjour et merci a tous d'avoir pris le temps d'y reflechir,

je vous repond dans l'ordre:

@ JP44: ton code fonctionne une fois adapté mais il fait simplement une boucle qui permette de copier les valeurs d'une colonne hors il ne prend pas en compte les criteres de tri.

@ Paf: En clair tu as tres bien résumé ce que je voulais dire sans y parvenir clairement. Je rajouterai juste que les critere de la colonne J peuvent changé d'une extraction a l'autre donc impossible de les definir a l'avance.

@robert: Alors la wahou tu as du y passé du temps helas a 'lexecution de la macro il me renvoi ceci "Cet objet ne gère pas cette propriété ou méthode (erreur 438)" et ton code étant a cent lieues au-dessus de mon niveau je ne comprend pas l'erreur.

Une question tout de meme les criteres ne sont-il pas definis dans excel autrement que par leur nom?

Merci encore. Je continu de chercher si vous avez d'autre piste n'hesitez pas..

 

[Robert]

Re : Boucle sur les critères d'un filtre

Bonjour le fil, bonjour le forum,

C'est le tri qui pose problème car la méthode a changé entre Excel 2003 et 2010. Je n'ai plus Excel 2003 mais j'ai essayé de refaire le code de mémoire. Si ça plante encore, supprime la ligne qui commence par pl.Sort... Le code :

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 col As Range 'déclare la variable col (COLonne)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim d As Object 'déclare la variable d (Dictionnaire)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim tmp As Variant 'déclare la variable tmp (tableau TeMPoraire)

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)
Set pl = o.Range("A1:M" & dl) 'définit la plage pl
Set col = o.Range("J2:J" & dl) 'définit la colonne col
'tri alphabétique reçupéré par l'enregistreur de macro
pl.Sort Key1:=col, Order1:=xlAscending, Header:=xlYes
Set d = CreateObject("Scripting.Dictionary") 'définit le dictionanire d
For Each cel In col 'boucle sur toutes les cellules cel de la colonne col
    d(cel.Value) = "" 'alimente le dictionnaire
Next cel 'prochaine cellule de la boucle
tmp = d.keys 'récupère les valeurs uniques (sans doublons) de la colonne col dans le tableau tmp
For i = 0 To UBound(tmp, 1) 'boucle sur toutes les valeurs uniques du tableau tmp
    'définit la cellule des destination (à adapter à ton cas)
    With Sheets("Feuil2") 'prend en compte l'onglet "Feuil2"
        'définit la destination (A1 si A1 est vide, sinon la seconde cellule vide rencontrée en colonne A)
        Set dest = IIf(.Range("A1").Value = "", .Range("A1"), .Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0))
    End With 'fin de la prise en compte de l'onglet "Feuil2"
    o.Range("A1").AutoFilter Field:=10, Criteria1:=tmp(i) 'filtre par rapport à la valeur uniqie tmp(i)
    pl.SpecialCells(xlCellTypeVisible).Copy dest 'copie les cellules visible de la plage pl et les colle dans dest
    o.Range("A1").AutoFilter 'supprime le filtre automatique
Next i 'prochaine valeur inique de la boucle
End Sub

Sinon, je n'ai pas vraiment compris ta question pour les critères... Mais tu peux utiliser une variable de type String, lui attribuer la valeur d'un cellule et utiliser cette variable comme critère, comme par exemple :

Dim crit As String
crit = Sheets("Feuil2").Range("A1").Value
Sheets("Feuil1").Range("A1").AutoFilter Field:=1, Criteria1:=crit

ou comme dans le code que je t'ai proposé où les critères sont stockés dans le tableau tmp puis utilisés par incrément de ce tableau (tmp(0), tmp(1), tmp(2), etc.)

 

[ioan44]

Re : Boucle sur les critères d'un filtre

Merci beaucoup robert pour ton investissement,

ton code fonctionne parfaitement je vais pouvoir l'etudier pour comprendre ces fonctions nouvelles pour moi et pour modifier la destination des tableaux et ajouter quelques enregistrements a droite a gauche.

Je note le probleme comme résolu.

Merci encore.

 

[Paf]

Re : Boucle sur les critères d'un filtre

re,

Même si, suivant l'extraction , les éléments de la colonnes J diffèrents, le tri et la copie sont les mêmes ?

Sub Extract()
Dim Derl as Integer

Derl = Worksheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Row

Worksheets("Feuil1").Range("A2:M" & Derl).Sort Key1:=Range("J1"), Order1:=xlAscending

Worksheets("Feuil1").Range("A1:M" & Derl).Copy Worksheets("Feuil2").Range("A1")

End Sub

Worksheets("Feuil1").Range("A2:M" & Derl).Copy Worksheets("Feuil2").Range("A1") pour ne pas avoir la ligne de titre

Bonne suite