Macro pour extraire des données d'une base en fonction de critères...

[Christian0258]

Bonjour à tout le forum,

Je souhaiterais votre aide pour l'écriture d'une macro...tout est dans l'intitulé...
voir fichier...

Je vous remercie pour votre aide si précieuse et pour le temps que vous voudrez bien m'accorder.

Bien amicalement,
Christian

 

[job75]

Re : Macro pour extraire des données d'une base en fonction de critères...

Bonjour Christian0258,

La macro dans le fichier joint :

Sub Trouver()
Dim tablo1, tablo2, d As Object, t1, t2
tablo1 = Range("F2", [F2].End(xlDown))
tablo2 = Range("H2", [H2].End(xlDown))
Set d = CreateObject("Scripting.Dictionary")
For Each t1 In tablo1
  For Each t2 In tablo2
    If InStr(t1, t2) And Not d.Exists(t1) Then d(t1) = t1
  Next
Next
With Sheets("Résultats")
  .[F2:F65536].ClearContents
  If d.Count = 0 Then MsgBox "Aucun plat trouvé...": Exit Sub
  .[F2].Resize(d.Count) = Application.Transpose(d.items)
  .[F2].Resize(d.Count).Sort .[F2], xlAscending, Header:=xlNo
  .Activate 'facultatif
End With
End Sub

Edit : ajouté un tri sur les résultats.

A+

 

[Christian0258]

Re : Macro pour extraire des données d'une base en fonction de critères...

Re, le forum, job75,

Que dire, job75, un grand merci évidemment, c'est parfait.

Bien à toi,
salut l'artiste.

Christian

 

[Christian0258]

Re : Macro pour extraire des données d'une base en fonction de critères...

Re, le forum,

job75 m'a fait la macro ci_dessus et je l'en remercie à nouveau.

J'ai toutefois besoin d'avoir un filtre sur la date...comment rajouter ce paramètre dans la macro.

Dans l'attente de vous lire.

Bien à vous,
Christian

 

[job75]

Re : Macro pour extraire des données d'une base en fonction de critères...

Bonjour Christian, le forum,

J'ai toutefois besoin d'avoir un filtre sur la date...

Cette macro fonctionne pour les 2 boutons Trouver DATE et Trouver TOUT :

Sub Trouver(dat As Date)
Dim tablo1, tablo2, d As Object, i&, v1$, v2, t
tablo1 = Range("B2", [F2].End(xlDown))
tablo2 = [H2:H50]
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo1)
  v1 = tablo1(i, 5): v2 = tablo1(i, 1)
  For Each t In tablo2
    If t = "" Then Exit For
    If InStr(v1, t) And IIf(dat, v2, dat) = dat _
      Then d(v1) = v1: Exit For
  Next
Next
With Sheets("Résultats")
  .[F2:F65536].ClearContents
  If d.Count = 0 Then MsgBox "Aucun plat trouvé...": Exit Sub
  .[F2].Resize(d.Count) = Application.Transpose(d.items)
  .[F:F].Sort .[F1], xlAscending, Header:=xlYes
  .Activate 'facultatif
End With
End Sub

Edition : voir post #10

A+

 

[job75]

Re : Macro pour extraire des données d'une base en fonction de critères...

Re,

Si l'on veut filtrer avec un filtre automatique, on peut utiliser cette version (3) :

Sub Trouver(F As Worksheet)
Dim tablo1, tablo2, d As Object, t1, t2
With Sheets("Résultats")
  Application.ScreenUpdating = False
  .[F:F].ClearContents
  F.[F:F].SpecialCells(xlCellTypeVisible).Copy .[F1]
  tablo1 = .Range("F2", .[F2].End(xlDown))
  tablo2 = F.[H2:H50]
  Set d = CreateObject("Scripting.Dictionary")
  For Each t1 In tablo1
    For Each t2 In tablo2
      If t2 = "" Then Exit For
      If InStr(t1, t2) Then d(t1) = t1: Exit For
    Next
  Next
  .Range("F2:F" & .Rows.Count).Delete xlUp 'nettoyage indispensable...
  If d.Count = 0 Then MsgBox "Aucun plat trouvé...": Exit Sub
  .[F2].Resize(d.Count) = Application.Transpose(d.items)
  .[F:F].Sort .[F1], xlAscending, Header:=xlYes
  .Activate 'facultatif
End With
End Sub

Edition : voir post #10

A+

 

[job75]

Re : Macro pour extraire des données d'une base en fonction de critères...

Re,

J'ai édité les 2 fichiers précédents, prenez les dernières versions.

Noter que le tri final a été modifié, c'était nécessaire quand le résultat a une seule ligne...

A+

 

[job75]

Re : Macro pour extraire des données d'une base en fonction de critères...

Re,

Bon quelque chose ne va pas.

Effacez par exemple H5:H7...

Je tâcherai de revoir cela à mon retour mardi 22/03.

A+

 

[Christian0258]

Re : Macro pour extraire des données d'une base en fonction de critères...

Re, le forum,

Avec un peu de retard, Lol..., merci beaucoup job75, pour tout le boulot.
La version 2 me va très bien, c'est impec.

Un grand merci.

Bien à toi,
Christian

 

[job75]

Re : Macro pour extraire des données d'une base en fonction de critères...

Bonjour Christian, le forum,

J'ai préféré modifier les versions (2) et (3), voir les posts #5 et #6.

1) 50 g en H2 trouve les textes avec 50 g mais aussi ceux avec 150 g, 250 g...

Pour qu'il ne trouve que 50 g, mettre un <espace> devant 50 g, tout simplement.

2) tablo2 est maintenant défini par tablo2 = [H2:H50], ce qui permet de traiter le cas où il n'y a pas de valeurs après H2 (ou H1).

Il faut alors le test supplémentaire If t = "" Then Exit For

A+

 

[job75]

Re : Macro pour extraire des données d'une base en fonction de critères...

Bonjour Christian, le forum,

Cette version (4) utilise le filtre élaboré (avancé).

Il faut sélectionner les critères dans la plage G1:J9.

Pour voir le travail du filtre, mettre en commentaire la ligne :

'FiltrerSansDoublonsColonneF False 'en commentaire pour voir le filtrage et le bouton

Sinon le bouton dans la feuille Résultats sera masqué.

Je me suis fait plaisir, mais ça devrait vous être utile, non ??

Edit : .[AF65536].End(xlUp)(2) et [F65536].End(xlUp)(2) pour avoir au moins 2 lignes à filtrer.

A+