Ignorer cellules vides dans plage de cellules

[Nico44044]

Bonsoir à tous,

Je souhaiterais pouvoir effectuer une recherche dans une feuille excel en effectuant une comparaison entre plusieur plage de cellules, en ignorant les cellules vide.(le tout en VBA)

J'ai un début de piste mais je bloque pour la suite.

Je joint un fichier avec plus de precisions ...

Ce code fonctionne il ne me reste plus qu'a trouver comment ignorer les criteres vide dans Range("A1:C1")


Option Explicit Sub es()
Dim a, b, c, d As Variant, i As Long, j As Long, t As Long, J1 As Long
Application.ScreenUpdating = False
With ActiveSheet.UsedRange For t = 2 To 15
a = Range("A1:C1").Value
b = Range("A" & t & ":C" & t).Value
c = Range("D" & t & ":F" & t).Value
d = Range("G" & t & ":I" & t).Value
For i = LBound(a, 2) To UBound(b, 2)
For j = LBound(a, 1) To UBound(a, 1)
If a(j, i) = b(j, i) Or a(j, i) = c(j, i) Or a(j, i) = d(j, i) Then
Else
Rows(t).Hidden = True
End If
Next j
Next i
Next t
End With
End Sub

Merci d'avance à celui qui pourra m'aider

 

[Nico44044]

tblBD = Range("F23:Z" & [F65000].End(xlUp).Row).Value

Boisgontier

Je viens de rencontrer un petit bug, a priori le code n'aime pas trop le mélange Lettre / Chiffre dans le meme critères.
Dans le tableau il y a plusieurs fois la ref "F500" dans la colonne Type et si je cherche juste "500" et bien il ne trouve rien ... alors les valeurs 500 et F500 sont bien présente

Une idée ??

Merci

 

[BOISGONTIER]

Modifier cette ligne:

Crit(i, 1) = Crit(i, 1) & "*"

Remplacer par:

Crit(i, 1) = "*" & Crit(i, 1) & "*"

http://boisgontierjacques.free.fr/fichiers/Cellules/RechercheBD3Groupes.xlsm

Boisgontier

 

[job75]

Bonjour Nico44044, JB, le forum,

La formule de mon post #29 est compliquée, j'ai donc créé la fonction personnalisée Comparer :

Dim crit$() 'mémorise la variable

Function Comparer(plage As Range) As Boolean
Dim i%
Comparer = True
For i = 1 To UBound(crit)
If Not LCase(plage(i)) Like crit(i) Then Comparer = False: Exit Function
Next
End Function

Sub Filtrer()
Dim deb As Range, ncol%, critere As Range, fin As Range, i%
Set deb = Feuil1.[F22] '1ère cellule, à adapter
ncol = 21 'à adapter
Set critere = Feuil1.[F22:I22] 'plage à adapter
Set fin = deb.Resize(, ncol).EntireColumn.Find("*", , xlValues, , xlByRows, xlPrevious)
If fin Is Nothing Then Exit Sub 'sécurité
If fin.Row < deb.Row + 1 Then Exit Sub 'tableau vide
ReDim crit(1 To critere.Count) 'tableau, plus rapide
For i = 1 To UBound(crit): crit(i) = "*" & IIf(critere(i) = "", "", LCase(critere(i)) & "*"): Next
Application.ScreenUpdating = False
With deb.Resize(fin.Row - deb.Row + 1, ncol)
    .Rows(2).EntireRow.Insert
    .Cells(2, 1) = "c1": .Cells(2, 1).AutoFill .Cells(2, 1).Resize(, ncol) 'titres provisoires
    .Cells(3, ncol + 1) = "=Comparer(F24:I24)+Comparer(M24:P24)+Comparer(T24:W24)"
    .Offset(1).AdvancedFilter xlFilterInPlace, .Cells(2, ncol + 1).Resize(2) 'filtre avancé
    .Cells(3, ncol + 1) = ""
    .Rows(2).EntireRow.Delete
End With
End Sub
Sub RAZ()
If Feuil1.FilterMode Then Feuil1.ShowAllData
End Sub

En contrepartie la durée d'exécution est un peu augmentée : 3,4 secondes sur 60 000 lignes.

Fichier (2).

Bonne journée.