recherche multi-critere

[Bernard]

Bonsoir à Tous ,

Je suis coincé sur une recherche multi-critères .

Si quelqu'un pouvait me dépanner , cele m'enlèverais une grosse épine du pied .

Actuellement j'ai fais une macro 'critere' qui me fais individuellement ma recherche par critère
mes filtres fonctionnent sauf sur le champ date où j'aimerai filtré par rapport à 2 dates (période)
J'aimerais faire une macro qui me fasse un filtre multi-critère par rapport à mes 3 choix de critère

Merci d'avance
Bonne soirée à Toutes et à Tous
Bernard

 

[Zon]

Salut Bernard,

Un truc du style à copier dans un module standard, tu n'as besoin d'adapter que la procédure le cas échéant:

Option Explicit
Option Base 1
Sub Princ()
Dim T
With Sheets(1)
If Not IsDate(.[C18]) Or Not IsDate(.[C20]) Then
MsgBox "Veuillez saisir une(des) date(s) SVP"
Exit Sub
End If
.[E14].CurrentRegion.ClearContents
T = Recherche(Sheets(2).[A2:E65536], .[C14].Text, .[C18], .[C20])
If IsArray(T) Then
.[E14].Resize(UBound(T, 2), 2) = Application.Transpose(T)
Else: .[E14] = "Rien trouvé"
End If
End With
End Sub
Function Recherche(Plage As Range, ByVal Valeur As String, Date1 As Range, Date2 As Range)
Dim C As Range, Adresse1 As String, I As Long, T
I = 1
With Plage
Set C = .Find(Valeur, , xlValues, xlWhole, xlByRows, , True)
If Not C Is Nothing Then
Adresse1 = C.Address
ReDim T(2, I)
Do
If Date1.Value2 < C.Offset(0, 4).Value2 < Date2.Value2 Then
ReDim Preserve T(2, I)
T(1, I) = C.Offset(0, 2).Value 'Prix
T(2, I) = C.Offset(0, 1).Value 'Poids
I = I + 1
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> Adresse1
End If
End With
Recherche = T
End Function

 

[Bernard]

Merci infiniement Zon pour ces explications et surtout pour cette macro je teste tout de suite
Bonne journée à toi et à tout le forum