Ignorer cellules vides dans plage de cellules

Nico44044

XLDnaute Nouveau
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
 

Pièces jointes

  • test moteur recherche v2.xlsm
    19.2 KB · Affichages: 29

Nico44044

XLDnaute Nouveau
0,2 sec pour 1.000 lignes, c'est énorme!!!

Boisgontier
Effectivement c'est rapide et très simple à utiliser.

Je voudrais juste rajouter la chose suivante :
comment faire dans ton code pour que le filtre prennent meme des valeurs partielles ?

Par exemple pour trouver "Paris" je voudrais aussi qu'il prennent en compte "Par" ...

je pense que c'est avec "*" mais je ne trouve pas ou le placer dans ton code ...
 

Nico44044

XLDnaute Nouveau
Le seul truc qui manque c'est de pouvoir taper un critère partiel sans rajouter le * à la saisie ...
En tapant uniquement Fia pour trouver Fiat par exemple.
C'est important car les critères seront alimenté dans le projet final par un UF donc pas de possibilité de rajouter le *.

Si vous me trouvez ca je suis au top ! :)
 

job75

XLDnaute Barbatruc
Re,
Par exemple pour trouver "Paris" je voudrais aussi qu'il prennent en compte "Par" ...
Fichier (4) avec la formule utilisant SEARCH (CHERCHE) :
Code:
    .Cells(3, 10) = "=AND(SUMPRODUCT(-ISNUMBER(SEARCH(""*""&A$1,A3:I3))),SUMPRODUCT(-ISNUMBER(SEARCH(""*""&B$1,A3:I3)))" _
        & ",SUMPRODUCT(-ISNUMBER(SEARCH(""*""&C$1,A3:I3))))" 'critères
Notez que l'astérisque "*" évite d'utiliser ISBLANK (ESTVIDE).

A+
 

Pièces jointes

  • test moteur recherche(4).xlsm
    24.2 KB · Affichages: 20

Nico44044

XLDnaute Nouveau
Re,

Fichier (4) avec la formule utilisant SEARCH (CHERCHE) :
Code:
    .Cells(3, 10) = "=AND(SUMPRODUCT(-ISNUMBER(SEARCH(""*""&A$1,A3:I3))),SUMPRODUCT(-ISNUMBER(SEARCH(""*""&B$1,A3:I3)))" _
        & ",SUMPRODUCT(-ISNUMBER(SEARCH(""*""&C$1,A3:I3))))" 'critères
Notez que l'astérisque "*" évite d'utiliser ISBLANK (ESTVIDE).

A+
Merci Bcp Job, j'ai appris plein de truc grace a ton code
 

job75

XLDnaute Barbatruc
Re,

Toujours avec le filtre avancé :
Code:
Sub Filtrer()
Dim deb As Range, ncol%, fin As Range
Set deb = Feuil1.[F22] '1ère cellule, à adapter
ncol = 21 'à 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
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(, 20) 'titres provisoires
    .Cells(3, ncol + 1) = "=ISNUMBER(SEARCH(""*""&F$22,CHAR(1)&F24)*SEARCH(""*""&G$22,CHAR(1)&G24)*SEARCH(""*""&H$22,CHAR(1)&H24)*SEARCH(""*""&I$22,CHAR(1)&I24))" _
        & "+ISNUMBER(SEARCH(""*""&F$22,CHAR(1)&M24)*SEARCH(""*""&G$22,CHAR(1)&N24)*SEARCH(""*""&H$22,CHAR(1)&O24)*SEARCH(""*""&I$22,CHAR(1)&P24))" _
        & "+ISNUMBER(SEARCH(""*""&F$22,CHAR(1)&T24)*SEARCH(""*""&G$22,CHAR(1)&U24)*SEARCH(""*""&H$22,CHAR(1)&V24)*SEARCH(""*""&I$22,CHAR(1)&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
La formule est plus compliquée car :

- la recherche se fait dans les colonnes dédiées de chacun des 3 tableaux

- des caractères CAR(1) sont insérés pour le cas où les cellules des tableaux sont vides, je vous laisse chercher pourquoi.

Fichier joint, testé sur 60 000 lignes => 1,8 seconde.

A+
 

Pièces jointes

  • Recherche filtre avancé(1).xlsm
    40.1 KB · Affichages: 20

Nico44044

XLDnaute Nouveau
Re,

Toujours avec le filtre avancé :
Code:
Sub Filtrer()
Dim deb As Range, ncol%, fin As Range
Set deb = Feuil1.[F22] '1ère cellule, à adapter
ncol = 21 'à 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
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(, 20) 'titres provisoires
    .Cells(3, ncol + 1) = "=ISNUMBER(SEARCH(""*""&F$22,CHAR(1)&F24)*SEARCH(""*""&G$22,CHAR(1)&G24)*SEARCH(""*""&H$22,CHAR(1)&H24)*SEARCH(""*""&I$22,CHAR(1)&I24))" _
        & "+ISNUMBER(SEARCH(""*""&F$22,CHAR(1)&M24)*SEARCH(""*""&G$22,CHAR(1)&N24)*SEARCH(""*""&H$22,CHAR(1)&O24)*SEARCH(""*""&I$22,CHAR(1)&P24))" _
        & "+ISNUMBER(SEARCH(""*""&F$22,CHAR(1)&T24)*SEARCH(""*""&G$22,CHAR(1)&U24)*SEARCH(""*""&H$22,CHAR(1)&V24)*SEARCH(""*""&I$22,CHAR(1)&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
La formule est plus compliquée car :

- la recherche se fait dans les colonnes dédiées de chacun des 3 tableaux

- des caractères CAR(1) sont insérés pour le cas où les cellules des tableaux sont vides, je vous laisse chercher pourquoi.

Fichier joint, testé sur 60 000 lignes => 1,8 seconde.

A+
Merci Job !
Je vais tester également ;-)
 

Discussions similaires

Réponses
11
Affichages
297

Statistiques des forums

Discussions
312 305
Messages
2 087 082
Membres
103 458
dernier inscrit
Vulgaris workshop