Discussion :

[thespeedy20]

Bonjour le Forum,

J'essaie d'exporter les données de mon filtre sur une autre page, via une macro créée par Monsieur Philippe Tulliez....(que je remercie)

Cela ne semble pas fonctionner :-(, il transfère toutes les données de la feuille Base à la feuille résultat et supprime toutes les données de ma feuille Base) et ne respecte pas mon filtre

Pouvez-vous m'aider svp....

Je vous en remercie par avance.

The speedy20

[tototiti2008]

Bonsoir,

un essai (écourté)

[thespeedy20]

Bonsoir tototiti2008,

Je te remercie pour ton essais (écourté).....:-) qui fonctionne très bien....

Merci à toi, je te souhaite une très bonne soirée...


Maintenant, j'aimerais savoir où est mon erreur dans l'adaptation de la macro de Philippe Tulliez...

Merci aux membres experts de ce forum, de me permettre de comprendre l'erreur commise...

TheSpeedy20

[Philippe Tulliez]

Bonjour,

Cela ne semble pas fonctionner :-(, il transfère toutes les données de la feuille Base à la feuille résultat et supprime toutes les données de ma feuille Base) et ne respecte pas mon filtre

Si tu publiais le code, ce serai mieux pour te répondre.

[thespeedy20]

Bonsoir Monsieur Tulliez

Voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub MoveByAdvancedFilter()
 ' http://philippe.tulliez.be
 Application.ScreenUpdating = False
 ' Déclaration des variables et constantes
 Const myFormula = "=ISERROR(SEARCH(M$9,A2)/LEN(M$9))*(Rech(A2,M$3)*Rech(Initiales(B2),N$3)+Rech(A2,M$4)*Rech(Initiales(B2),N$4)+Rech(Initiales(B2),N$6)+Rech(Initiales(B2),N$7))" 'critère
 Const EvalFormula = "=DCOUNTA([Data],A1,[Criteria])"
 Dim areaSource As Range, areaCriteria As Range, areaTarget As Range
 ' Zone Data (Source) & Export (Cible)
 With ThisWorkbook
  Set areaSource = .Worksheets("Base").Range("A1").CurrentRegion
  Set areaTarget = .Worksheets("Resultat").Range("A1")
 End With
 ' Zone des critères 2 colonnes à droite de la zone Data
     With areaSource
      Set areaCriteria = .Resize(2, 1).Offset(columnoffset:=.Columns.Count + 1)
     End With
     areaCriteria(1) = myFormula
 If Evaluate(Replace(Replace(EvalFormula, "[Data]", areaSource.Address), "[Criteria]", areaCriteria.Address)) Then
     With areaSource
     .AdvancedFilter xlFilterCopy, areaCriteria, areaTarget ' Exportation des données
     .AdvancedFilter xlFilterInPlace, areaCriteria          ' Filtre sur place
      areaCriteria.Clear                                    ' Suppression des critères
      ' Suppression des lignes filtrées
     .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
      With .Worksheet: .Activate: .ShowAllData: End With    ' Supprime le filtre
     End With
   Else
     MsgBox "Pas d'éléments correspondant aux critères"
 End If
 Application.ScreenUpdating = True
 Set areaSource = Nothing: Set areaTarget = Nothing: Set areaCriteria = Nothing
End Sub

[Philippe Tulliez]

Bonjour,
J'ai essayé de retrouver ce code que j'ai publié et manifestement c'est dans cette discussion ici
Cependant dans le code que tu as publié il manque la ligne de code qui écrit le titre du filtre et de plus dans la ligne ci-dessous, il semblerait qu'il y ait deux fonctions personnalisées nommée Rech et Initiales que je ne retrouve nulle part

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Const myFormula = "=ISERROR(SEARCH(M$9,A2)/LEN(M$9))*(Rech(A2,M$3)*Rech(Initiales(B2),N$3)+Rech(A2,M$4)*Rech(Initiales(B2),N$4)+Rech(Initiales(B2),N$6)+Rech(Initiales(B2),N$7))" 'critère

[thespeedy20]

re,

oups... voici

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Option Explicit
Option Compare Text 'la casse est ignorée (pour Like)
 
Function Initiales$(t$)
Dim i%
t = " " & t
For i = 2 To Len(t)
  If Mid(t, i - 1, 1) = " " Then Initiales = Initiales & Mid(t, i, 1)
Next
Initiales = UCase(Initiales) 'majuscules, facultatif
End Function
 
Function Rech(t$, critere$) As Boolean
Rech = t Like critere
End Function

[Philippe Tulliez]

Bonjour,
Voici ci-dessous le code original de la procédure nommée MoveByAdvancedFilter que j'ai publié le 9/05/2016 dans cette discussion et que tu as utilisé en l'amputant certaines lignes et dont tu as modifié la formule permettant du critère calculé pour qu'elle corresponde à ton cas.

J'ai simplement corrigé la formule qui effectue le filtre non plus sur la colonne J mais M parce-que la liste de données que j'utilise pour mes tests a été enrichie de trois colonnes de plus (ligne 5 du code ci-dessous)
J'ai aussi déplacé la ligne qui supprime la zone des critères (areaCriteria.Clear) en ligne 30

J'ai mis le classeur ayant servi d'exemple en téléchargement
Tu verras que la procédure copie bien toutes les lignes dont la valeur de la colonne M contient soit VW, soit Toyota vers la feuille [Export] et qu'ensuite ces lignes sont supprimées
J'ai également ajouté une procédure nommée TestMoveByAdvancedFilter pour effectuer plusieurs test et qui permet de repartir d'un backup contenant la liste d'origine.

Seule contrainte

• Il faut lancer la procédure avec comme feuille active la liste source (Feuille [db]) mais la procédure de test l'active automatiquement
• La feuille [db] ne peut pas être vide (je n'ai pas ajouté de test sur ce cas)

donc si ta formule est correcte et que tu la places dans la constante myFormula et que le nom des feuilles est adapté, il n'y a aucune raison que cela ne fonctionne pas.

Attention que pour invoquer la procédure de copie de la feuille [BackUp], j'utilise le CodeName des feuilles


La procédure nommée MoveByAdvancedFilter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub MoveByAdvancedFilter()
 ' Philippe Tulliez - www.magicoffice.be
 Application.ScreenUpdating = False
 ' Déclaration des variables et constantes
 Const myFormula = "=OR(M2=""VW"",M2=""Toyota"")"
 Const EvalFormula = "=DCOUNTA([Data],A1,[Criteria])"
 Dim areaSource As Range, areaCriteria As Range, areaTarget As Range
 ' Zone Data (Source) & Export (Cible)
 With ThisWorkbook
  Set areaSource = .Worksheets("db").Range("A1").CurrentRegion
  Set areaTarget = .Worksheets("Export").Range("A1")
 End With
 ' Zone des critères 2 colonnes à droite de la zone Data
     With areaSource
      Set areaCriteria = .Resize(2, 1).Offset(columnoffset:=.Columns.Count + 1)
     End With
     areaCriteria(1) = "_fn_"
     areaCriteria(2) = myFormula
 If Evaluate(Replace(Replace(EvalFormula, "[Data]", areaSource.Address), "[Criteria]", areaCriteria.Address)) Then
     With areaSource
     .AdvancedFilter xlFilterCopy, areaCriteria, areaTarget ' Exportation des données
     .AdvancedFilter xlFilterInPlace, areaCriteria          ' Filtre sur place
      ' Suppression des lignes filtrées
     .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
      With .Worksheet: .Activate: .ShowAllData: End With    ' Supprime le filtre
     End With
   Else
     MsgBox "Pas d'éléments correspondant aux critères"
 End If
 areaCriteria.Clear ' Suppression des critères
 Application.ScreenUpdating = True
 Set areaSource = Nothing: Set areaTarget = Nothing: Set areaCriteria = Nothing
End Sub

[thespeedy20]

Bonjour,

Merci pour vos explications très claires....

Ma formule ne semble pas fonctionner...:-(... j'ai même retiré" initiales".....Je comprends pas...

j'ai des critères sur deux colonnes....

Formation musicale en A1 et Q1 en A2 = Formation musicale Q1
Formation musicale en A1 et QA1 en A2 = Formation musicale QA1

et tous les autres cours : en Q5 ou en QA4

voilà ce que je dois extraire....

Pouvez-vous m'aidez à résoudre mon problème de formule...

Je vous en remercie....

[Philippe Tulliez]

Bonjour,
Pour filtrer des données que ce soit sur place ou par exportation, il faut que la formule (critère nommé) présente dans la zone des critères renvoie VRAI (True pour VBA)

Aider à résoudre le ou les formules n'a plus rien avec cette discussion qui traite de Copie/Suppression suivant critères or nous voyons bien que la procédure fonctionne à condition que la formule renvoie bien VRAI ou FAUX

Je suggère donc d'ouvrir autant de discussion qu'il n'y a de fonction personnalisée ou fonction à résoudre et bien expliquer ce que l'on passe comme argument à la fonction et ce qu'on en attentant à la sortie

Petit conseil : Plutôt que de tester la formule complète qui je l'admet peut-être quelque peu indigeste à la lecture, il suffit de tester chaque morceau de test dans une cellule à part pour voir si déjà elle renvoie une valeur booléenne.
Il ne faut pas oublier non plus que si dans la formule des critères on fait référence à une cellule qui se trouve en dehors de la zone des données, il y a lieu de la référener comme absolue (Les $ précédent chaque élément de la référence. Par exemple dans N2=$M$4, N2 est la cellule de la première ligne de la zone data et $M$4 est une cellule en dehors de cette zone où se trouve une valeur que l'on compare par égalité dans la colonne N de la zone des données)
A titre indicatif, en sélectionnant une partie de fonction d'une longue formule et en n'oubliant pas de bien prendre la première et dernière parenthèse, en appuyant sur la touche F9, on obtient le résultat de cette partie sélectionnée

[thespeedy20]

Philippe Tulliez,

Merci pour tous les conseils, je suis enfin arriver à bout de cette formule...


Bonne fin de journée....

Encore merci

Oli