Public comptdeca As Integer
Public comptmodif As Integer
Public comptboucle As Integer
Public etatm As Boolean
Public etata As Boolean
Option Explicit
Sub FiltreCrit(Plage As Range, Critere As String, Col As Long)
If Critere = "" Then
Plage.AutoFilter Field:=Col
Else
Plage.AutoFilter Field:=Col, Criteria1:=Critere
End If
Sheets("database").Activate
Range("A3").Select
End Sub
Sub Filtre()
'Appel des variables
Dim Plage As Range
Dim derLig As Long
Dim Critere As Byte
Dim nbLigneAff As Long
Application.ScreenUpdating = False
With Sheets("database")
'Enlever le filtre
.Range("A2:Q" & Cells.Rows.Count).AutoFilter
'Dernière ligne
derLig = .Range("A" & Cells.Rows.Count).End(xlUp).Row
Set Plage = .Range("A2😛" & derLig)
End With
'Effacer les données
'Sheets("Consultation").Range("B22:O" & Cells.Rows.Count).Clear
'Boucle sur tous les critères
For Critere = 4 To 18
'Pour les critères Référence, Titre et Résumé dont la cellule contient le critère
If Critere = 14 Or Critere = 15 Then
'Si le critère n'est pas vide
If Sheets("Search").Range("C" & Critere).Value <> "" Then
Call FiltreCrit(Plage, "*" & Sheets("Search").Range("C" & Critere).Value & "*", Critere - 3)
End If
'Critères de type Liste de validation
Else
Call FiltreCrit(Plage, Sheets("Search").Range("C" & Critere).Value, Critere - 3)
End If
Next Critere
'Afficher les nouvelles données filtrées
Sheets("database").Range("A2:Q" & derLig).SpecialCells (xlCellTypeVisible)
'Vérifier si au moins une ligne affichée
nbLigneAff = Sheets("database").Range("A2:A" & derLig).SpecialCells(xlCellTypeVisible).Count
'Si seulement une ligne visible, afficher toutes les valeurs de la base
If nbLigneAff = 1 Then
MsgBox "Aucune donnée ne correspond aux critères.", vbInformation
Sheets("Search").Select
End If
Range("A3").Select
comptdeca = 0
Range("B" & 23 + comptdeca).Select
'Application.ScreenUpdating = True
End Sub