Copier lignes selon 2 critères et via Userform

[350dr]

Bonjour le forum,
Je vous sollicite une nouvelle fois pour un problème de tri selon 2 critères et via un UserFom.
Je lance mon userform, je sélectionne 2 critères possibles selon les possibilités proposées et je souhaite copier le résultat de la requête dans la feuille résultat.
J’ai trouvé une solution sur ce forum mais elle ne fonctionne que si les colonnes scrutées se suivent, or, dans mon cas, le premier critère se trouve en colonne B et le 2ème en F.
Du coup il faut que je passe par la commande "Autofilter" et c’est là que j’ai besoin de vos lumières…les miennes sont pas brillantes !!!
J’ai vu beaucoup de solution qui se rapproche de mon problème mais maintenant je mélange tout ….
Merci de votre aide

 

[phlaurent55]

Re : Copier lignes selon 2 critères et via Userform

Bonjour 350dr,

ton fichier en retour

à+
Philippe

 

[job75]

Re : Copier lignes selon 2 critères et via Userform

Bonjour 350dr,

On peut effectivement utiliser un filtre avancé (élaboré) :

'Bouton Trier
Private Sub CommandButton1_Click()
If ComboBox1 = "" Then ComboBox1.DropDown: Exit Sub
If ComboBox2 = "" Then ComboBox2.DropDown: Exit Sub
Dim dest As Range
Application.ScreenUpdating = False
Set dest = Feuil2.Range("A" & Feuil2.[B65536].End(xlUp).Row + 1)
[K2] = "=AND(B2=""" & ComboBox1 & """,F2=""" & ComboBox2 & """)"
With Range("A1:J" & [B65536].End(xlUp).Row)
  .AdvancedFilter xlFilterInPlace, [K1:K2] 'filtre avancé
  On Error Resume Next 'si aucune donnée filtrée
  .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy dest
  .AdvancedFilter xlFilterInPlace, ""
End With
[K2] = ""
If Err = 0 Then
  dest(1, 11) = ComboBox1 'colonne K
  dest(1, 12) = ComboBox2 'colonne L
  dest.Parent.Activate 'facultatif
  Unload UserForm1
End If
Application.ScreenUpdating = True
If Err Then MsgBox "Aucune donnée filtrée..."
End Sub

Fichier joint.

Edit : dans la feuille Résultat j'ai mis une MFC sur les colonnes K:L.

A+

 

[job75]

Re : Copier lignes selon 2 critères et via Userform

Re,

Dans cette version (1 bis) les résultats du filtrage se décalent d'une ligne :

Set dest = Feuil2.Range("A" & Feuil2.[B65536].End(xlUp).Row + 2)

Edit : ah mais Salut Philippe, je ne t'avais pas vu

A+

 

[350dr]

Re : Copier lignes selon 2 critères et via Userform

Nickel. Merci à vous 2 je vois que vous êtes encore là pour m'aider !!!
C’est vraiment sympa.
J'avoue mieux comprendre la solution de Philippe mais Job75 je te remercie infiniment.
Je ne savais pas que l'on pouvait prendre comme critère les valeurs d'une combobox "Criteria1:=ComboBox" mais c'est vrai que ça simplifie du coup le code.
Je commençais à m'emmêler les pinceaux !
Juste une dernière question: peux-tu m'explique le :"AutoFilter Field:=6" que veux dire Field:=6 ou =3 dans le code?
Encore merci

 

[phlaurent55]

Re : Copier lignes selon 2 critères et via Userform

Re,

Juste un dernière question: peux-tu m'explique le :"AutoFilter Field:=6" que veux dire Field:=6

ça veut tout simplement dire que l'on filtre sur la 6ème colonne du tableau

à+
Philippe

 

[350dr]

Re : Copier lignes selon 2 critères et via Userform

Laissez tomber pour la question je viens de comprendre en étudient de plus près, le field:=2 ou =6 correspond aux n° des colonnes.
Merci

 

[350dr]

Re : Copier lignes selon 2 critères et via Userform

Nos messages se sont croises. Merci Philippe.

 

[350dr]

Re : Copier lignes selon 2 critères et via Userform

Philippe, Job75, le forum, je reviens vers vous pour une petite modif.
Voilà, j'utilise la solution de Philippe (fichier 111) et je m'aperçois qu’à l’utilisation qu’il est nécessaire d’ajouter une condition de non tri des données quand il n’y a pas de ligne de résultat.
En gros je souhaiterai que le tri ne se fasse pas (avec renvoi de Mgbox) si aucune ligne ne correspond aux 2 critères.
If « aucune ligne avec ces 2 critères » then exit sub
Puis Mgbox « pas de résultat »
Et donc retour à l’userform de sélection.
Comment traduire ça en VBA ?
(Si je ne fais pas ça, dans la suite de mon programme j'ai une erreur division par 0 car pas de résultat)
Merci de votre aide

 

[job75]

Re : Copier lignes selon 2 critères et via Userform

Bonjour 350dr,

Avant le filtrage tester avec NB.SI :

If Application.CountIf([B:B], ComboBox1) * Application.CountIf([F:F], ComboBox2) = 0 Then
  MsgBox "Pas de résultat..."
  Exit Sub
End If

A+

 

[350dr]

Re : Copier lignes selon 2 critères et via Userform

Bonjour Job75
Merci pour ta réponse,
J'ai incéré ton code avant le tri mais il m’affiche la Msgbox même s’il existe des résultats.
Sinon dans mon document réel, les critères se trouvent en M et AU, donc il suffit, si j’ai bien compris, de remplacer [B:B] par [M:M] et [F:F] par [AU:AU]. Tu confirmes ?
Merci

 

[350dr]

Re : Copier lignes selon 2 critères et via Userform

Annule et remplace:
Autant pour moi, ça marche, j'avais fait une vilgaire erreur de recopiage !!!!!
Un grand merci à toi
Cdlt

 

[350dr]

Re : Copier lignes selon 2 critères et via Userform

Bon, finalement je reviens vers toi Job75 car après plusieurs tests ton code ne fonctionne pas toujours.
exemple si tu selectionnes TP dans "test" (combobox1) et STA-OUT QC 2P dans "niveau de contrôle" (combobox2), il n'y a pas de résultat mais le tri se fait quand même.

Application.ScreenUpdating = False
'Si la Combobox1 est vide alors envoie message
If ComboBox1 = "" Then
MsgBox ("Sélectionnez un test dans la liste déroulante")
Exit Sub
End If
'Si la Combobox2 est vide alors envoie message
If ComboBox2 = "" Then
MsgBox ("Sélectionnez un niveau de contrôle dans la liste déroulante")
Exit Sub
End If
If Application.CountIf([B:B], ComboBox1) * Application.CountIf([F:F], ComboBox2) = 0 Then
MsgBox "Pas de résultat..."
Exit Sub
End If
Sheets("Résultat").Cells.ClearContents
Sheets("Données").Select
Range("A1").Select
Selection.AutoFilter
...
Une autre idée?
Merci

 

[job75]

Re : Copier lignes selon 2 critères et via Userform

Re,

Oui ce n'est finalement pas le test qu'il faut.

A+

 

[job75]

Re : Copier lignes selon 2 critères et via Userform

Re,

Je pense que le plus simple est de filtrer dans tous les cas.

Et si la seule ligne visible est la ligne 1 terminer la macro en désactivant le filtre :

If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then
  MsgBox "Pas de résultat"
  ActiveSheet.AutoFilterMode = False
  Exit Sub
End If

A+