XL 2019 Filtre avancé + Colonnes spécifiques (VBA)

Amilo

XLDnaute Accro
Bonjour le forum,

J'aurais svp une nouvelle demande concernant mon précédent fil créé ici,
Dans le résultat du filtre avancé (onglet Résultat"), je souhaiterais pouvoir compléter librement des informations à côté de ma plage de résultat
Pour cela, j'ai ajouté 3 nouvelles colonnes "Commentaire", "Code" et "Mts" qui seront renseignées manuellement au fil du temps

Malheureusement, le code VBA actuel ne fonctionne pas dans ce cas précis.

En vous remerciant par avance pour votre aide

Cordialement
 

Pièces jointes

  • Filtre avancé_V2.xlsm
    21.1 KB · Affichages: 7

Amilo

XLDnaute Accro
Bonjour @fanfan38,
Merci pour cette proposition,
J'avais déjà testé plusieurs tentatives dont celle-ci mais cela m'écrase les valeurs que je rentre dans la feuille "Résultat".
Cela fonctionnerait seulement si je saisie les valeurs dans la feuille "Source" que je souhaite pas.
J'ai également essayé d'adapter le code VBA, en indiquant des plages mais en vain.
Merci en tout cas.
Cordialement
 

cp4

XLDnaute Barbatruc
Bonjour,

@Amilo : Si j'ai bien compris
VB:
Sub Extrait()
  Sheets("source").Range("A3:C15").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("critères").Range("A3:C5"), CopyToRange:=Range( _
      "Résultat!Extract"), Unique:=False
End Sub

Bon week-end.
 

Amilo

XLDnaute Accro
Bonjour @cp4 ,

Merci également pour votre message,
Cela fonctionne effectivement mais j'ai plusieurs craintes :
- je dois encore le tester sur un fichier de 20 000 lignes env. pour voir la durée d'exécution,
- et aussi, le décalage des valeurs si j'ajoute un nouveau critère dans ma zone.
Par exemple, si dans ma zone de critères j'ai 12 et 13 et que j'ajoute un 3ème critère par exemple le 11, cela va me décaler les commentaires sur les mauvaises lignes.
En principe ma zone de critères ne devrait plus changer mais j'aimerais prendre toutes les précautions.

Merci

Cordialement
 

cp4

XLDnaute Barbatruc
Dans la 1ère macro, le résultat n'était effacé. Si j'ai bien compris ta demande.
VB:
Sub Extrait()
Dim t As Single
t = Timer
Application.ScreenUpdating = False
Sheets("Résultat").Range("A3").CurrentRegion.Offset(1).ClearContents

  Sheets("source").Range("A3:C15").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("critères").Range("A3:C5"), CopyToRange:=Range( _
      "Résultat!Extract"), Unique:=False
Application.ScreenUpdating = False
MsgBox (Timer - t) / 1000 & " milliseconde"
End Sub
 

Amilo

XLDnaute Accro
Re,
Je viens de tester le code de @cp4 (#6) avec une légère modification sur la 5ème ligne (test sur un fichier de 45000 lignes) :
- C'est très rapide (0,00025 milliseconde) et c'est parfait du côté durée d'exécution même avec un gros fichier
- Le seul problème est que les commentaires se décalent à l'ajout d'un nouveau critère
J'ai mis 2 captures pour illustrer ce problème avant et après modification de la zone de critères

Cordialement

VB:
Sub Extrait()
Dim t As Single
t = Timer
Application.ScreenUpdating = False
Sheets("Résultat").Range("A3:C15").ClearContents

  Sheets("Source").Range("A3:C15").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("critères").Range("A3:C6"), CopyToRange:=Range( _
      "Résultat!Extract"), Unique:=False
Application.ScreenUpdating = False
MsgBox (Timer - t) / 1000 & " milliseconde"
End Sub
 

Pièces jointes

  • Filtre avancé_1.jpg
    Filtre avancé_1.jpg
    127 KB · Affichages: 9
  • Filtre avancé_2.jpg
    Filtre avancé_2.jpg
    139.4 KB · Affichages: 10

cp4

XLDnaute Barbatruc
Re,
Je viens de tester le code de @cp4 (#6) avec une légère modification sur la 5ème ligne (test sur un fichier de 45000 lignes) :
- C'est très rapide (0,00025 milliseconde) et c'est parfait du côté durée d'exécution même avec un gros fichier
- Le seul problème est que les commentaires se décalent à l'ajout d'un nouveau critère
J'ai mis 2 captures pour illustrer ce problème avant et après modification de la zone de critères

Cordialement

VB:
Sub Extrait()
Dim t As Single
t = Timer
Application.ScreenUpdating = False
Sheets("Résultat").Range("A3:C15").ClearContents

  Sheets("Source").Range("A3:C15").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("critères").Range("A3:C6"), CopyToRange:=Range( _
      "Résultat!Extract"), Unique:=False
Application.ScreenUpdating = False
MsgBox (Timer - t) / 1000 & " milliseconde"
End Sub
Bonjour,
Voici le code modifié pour des plages dynamiques.
Pour le décalage, je n'ai pas compris. Si tes commentaires sont mis après un filtrage, c'est normal qu'au filtrage suivant il y a un décalage car c'est autre filtrage avec des critères différents.

VB:
Sub Extrait1()
Dim t As Single, Ps As Range, Pc As Range
t = Timer
Set Ps = Sheets("source").Range("A3").CurrentRegion 'plage de données sources
Set Pc = Sheets("critères").Range("A3").CurrentRegion 'plage de critères

Application.ScreenUpdating = False
Sheets("Résultat").Range("A3").CurrentRegion.Offset(1).ClearContents 'effacer precedent resultat du filtre

  Ps.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Pc, CopyToRange:=Range( _
      "Résultat!Extract"), Unique:=False        'Nouveau filtre élaborcé

Application.ScreenUpdating = False
MsgBox (Timer - t) / 1000 & " ms"

Set Ps = Nothing
Set Pc = Nothing
End Sub
 

Amilo

XLDnaute Accro
Bonjour @cp4 ,
Merci encore pour ce code,
Je vais le tester pour voir mais je pense qu'il fonctionnera sans problème.
Concernant le décalage, je pensais qu'il serait possible avec VBA.
Je vais sinon utiliser Power Query qui le fait assez facilement pour cette 2ème partie.
Encore merci à tous pour votre aide
Cordialement
 

Discussions similaires

Réponses
12
Affichages
486

Statistiques des forums

Discussions
313 271
Messages
2 096 724
Membres
106 720
dernier inscrit
Alain EDZOA