Ignorer cellules vides dans plage de cellules
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 ...
Merci d'avance à celui qui pourra m'aider
J'avance un peu :
Ce code fonctionne il ne me reste plus qu'a trouver comment ignorer les criteres vide
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 SubLa je seche
Bonjour,
Un essai ... Si soit A ou C vide ... pas encore trouvé si c'est B qui sera vide.
Il y a sûrement des améliorations à faire ...
Sub es()
Dim a, b, c, d As Variant, i As Long, j As Long, t As Long, J1 As Long
Dim CR As Byte
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
If Cells(1, "A") <> "" And Cells(1, "B") <> "" And Cells(1, "C") <> "" Then CR = 1
If Cells(1, "A") <> "" And Cells(1, "B") <> "" And Cells(1, "C") = "" Then CR = 2
If Cells(1, "A") <> "" And Cells(1, "B") = "" And Cells(1, "C") <> "" Then CR = 3
If Cells(1, "A") = "" And Cells(1, "B") <> "" And Cells(1, "C") <> "" Then CR = 4
Select Case CR
Case 1
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
Case 2
For t = 2 To 15
a = Range("A1:B1").Value
b = Range("A" & t & ":B" & t).Value
c = Range("D" & t & ":E" & t).Value
d = Range("G" & t & ":H" & 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
Case 4
For t = 2 To 15
a = Range("B1:C1").Value
b = Range("B" & t & ":C" & t).Value
c = Range("E" & t & ":F" & t).Value
d = Range("H" & 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 Select
End With
End Subric
Merci ric
Je teste ca de suite
Bon l'idée était bonne mais si je ne mets qu'un seul critere (meme en B1) ca ne fonctionne pas
Si je rentre "207" en B1 la macro ne trouve rien
Bonjour,
Oui, c'était un essai : soit A et B ou B et C.
En trouvant pour A et C ... j'aurai probablement A ou B ou C.
Mais je ne suis pas trop familier avec les variables tableau.
Je continue à m'amuser.
ric
Si t'as une autre approche qui fonctionne je suis egalement preneur
En sachant qu'a terme j'aurais beacoup plus que 3 criteres ... la j'en ai mis 3 pour "simplifier "
Bonjour,
Ce n'est sûrement pas le meilleur code, mais il a l'avantage de fonctionner.
Soit A ou B ou C
Soit AB ou BC ou AC
Ou encore ABC
Sub es()
Dim a, b, c, d As Variant, i As Long, j As Long, J1 As Long
Dim t1 As Long, t2 As Long
Dim CR As Byte
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
If Cells(1, "A") <> "" And Cells(1, "B") <> "" And Cells(1, "C") <> "" Then CR = 1
If Cells(1, "A") <> "" And Cells(1, "B") <> "" And Cells(1, "C") = "" Then CR = 2
If Cells(1, "A") <> "" And Cells(1, "B") = "" And Cells(1, "C") <> "" Then CR = 3
If Cells(1, "A") = "" And Cells(1, "B") <> "" And Cells(1, "C") <> "" Then CR = 4
If Cells(1, "A") <> "" And Cells(1, "B") = "" And Cells(1, "C") = "" Then CR = 5
If Cells(1, "A") = "" And Cells(1, "B") <> "" And Cells(1, "C") = "" Then CR = 6
If Cells(1, "A") = "" And Cells(1, "B") = "" And Cells(1, "C") <> "" Then CR = 7
Select Case CR
Case 1
For t1 = 2 To 15
a = Range("A1:C1").Value
b = Range("A" & t1 & ":C" & t1).Value
c = Range("D" & t1 & ":F" & t1).Value
d = Range("G" & t1 & ":I" & t1).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(t1).Hidden = True
End If
Next j
Next i
Next t1
Case 2
For t1 = 2 To 15
a = Range("A1:B1").Value
b = Range("A" & t1 & ":B" & t1).Value
c = Range("D" & t1 & ":E" & t1).Value
d = Range("G" & t1 & ":H" & t1).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(t1).Hidden = True
End If
Next j
Next i
Next t1
Case 3
For t1 = 2 To 15
a = Range("A1").Value
b = Range("A" & t1).Value
c = Range("D" & t1).Value
d = Range("G" & t1).Value
i = 1
'' j = t
If a = b Or a = c Or a = d Then
Else
For t2 = 2 To 15
a = Range("C1").Value
b = Range("C" & t2).Value
c = Range("F" & t2).Value
d = Range("I" & t2).Value
i = 1
If a = b Or a = c Or a = d Then
Else
Rows(t2).Hidden = True
End If
Next t2
Rows(t1).Hidden = True
End If
Next t1
Case 4
For t1 = 2 To 15
a = Range("B1:C1").Value
b = Range("B" & t1 & ":C" & t1).Value
c = Range("E" & t1 & ":F" & t1).Value
d = Range("H" & t1 & ":I" & t1).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(t1).Hidden = True
End If
Next j
Next i
Next t1
Case 5
For t2 = 2 To 15
a = Range("A1").Value
b = Range("A" & t2).Value
c = Range("D" & t2).Value
d = Range("G" & t2).Value
i = 1
If a = b Or a = c Or a = d Then
Else
Rows(t2).Hidden = True
End If
Next t2
Case 6
For t2 = 2 To 15
a = Range("B1").Value
b = Range("B" & t2).Value
c = Range("E" & t2).Value
d = Range("H" & t2).Value
i = 1
If a = b Or a = c Or a = d Then
Else
Rows(t2).Hidden = True
End If
Next t2
Case 7
For t2 = 2 To 15
a = Range("C1").Value
b = Range("C" & t2).Value
c = Range("F" & t2).Value
d = Range("I" & t2).Value
i = 1
If a = b Or a = c Or a = d Then
Else
Rows(t2).Hidden = True
End If
Next t2
End Select
End With
End Subric
Bonjour,
Facilement adaptable à plusieurs critères.
Sub Filtre()
TblBD = Range("A2:I" & [A65000].End(xlUp).Row).Value
raz
NGroupe = 3 ' adapter
Dim Crit()
Crit = Application.Transpose([A1:C1])
For i = 1 To UBound(Crit)
If Crit(i, 1) = "" Then Crit(i, 1) = "*"
Next i
For i = 1 To UBound(TblBD)
ok1 = False
For k = 1 To NGroupe
ok2 = True
For kk = 1 To NGroupe
If Not TblBD(i, (k - 1) * Ubound(Crit)+ kk) Like Crit(kk, 1) Then ok2 = False
Next kk
If ok2 Then ok1 = True
Next k
If Not ok1 Then Rows(i + 1).Hidden = True
Next i
End Sub
Sub raz()
Rows.Hidden = False
End SubBoisgontier
Bonjour à tous,
@Boisgontierjacques
Il y a quelques bogues ...
Entre autres ...
Une recherche (Fiat, 500, Noir) donne 2 lignes ... dont la 2e n'a aucune correspondance.
Une recherche (Peugeot, 207, Noir) donne 5 lignes ... dont 2 lignes n'ont aucune correspondance et la 3e n'a qu'un critère.
ric
Bonjour à tous,
Reconverti en 3 critères pour correspondre à la demande initiale de Nico44044, ça fonctionne bien.
Option Explicit
Sub es()
Dim TblBD
Dim I As Integer
Dim K As Integer
Dim KK As Integer
Dim NGroupe As Byte
Dim ok1 As Boolean
Dim ok2 As Boolean
Dim Crit()
Application.ScreenUpdating = False
Rows.Hidden = False
TblBD = Range("A2:i" & [A65000].End(xlUp).Row).Value
NGroupe = 3 ' adapter
Crit = Application.Transpose([A1:C1])
For I = 1 To UBound(Crit)
If Crit(I, 1) = "" Then Crit(I, 1) = "*"
Next I
For I = 1 To UBound(TblBD)
ok1 = False
For K = 1 To NGroupe
ok2 = True
For KK = 1 To UBound(Crit)
If Not TblBD(I, (K - 1) * UBound(Crit) + KK) Like Crit(KK, 1) Then ok2 = False
Next KK
If ok2 Then ok1 = True
Next K
If Not ok1 Then Rows(I + 1).Hidden = True
Next I
End SubJe ne sais pas si mon cerveau va réussir un jour à assimiler les variables tableaux ...
ric
Merci ric et Boisgontier pour vos contributions,
Boisgontier : les bug sont ils toujours d'actualité dans la version 4 critères ?
J'arrive a rajouter des critères c'est parfait, par contre 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 ...
ric : merci pour ta version , je vais la tester aussi
>Par exemple pour trouver "Paris" je voudrais aussi qu'il prennent en compte "Par" ...
J'ai ajouté des menus déroulants pour les critères
Boisgontier
J'ai ajouté des menus déroulants pour les critères
Boisgontier
Sympa mais ca rend la recherche restrictive alors qu'au contraire je veux pouvoir chercher les critères meme partiellement
Par exemple pour Fiat je veux que meme si je tape que "Fia" dans le critère marque il me trouve Fiat.
Mais je sais pas ou modifier ca dans ton code
Fia*
Boisgontier
Désolé d'insister mais possible sans rajouter le * dans la saisie ? Juste en tapant Fia ? le coté partiel est hyper important pour le projet final
Encore besoin d'un dernier petit coup de main avec ton code Boisgontier :
Pour les besoin du projet final j'ai besoin de faire démarrer le tableau en F22 (comme sur le fichier joint)
J'ai fait des modifier mais cela ne donne rien quand je filtre ...
Merci de ton aide
tblBD = Range("F23:Z" & [F65000].End(xlUp).Row).Value
Option Compare Text
Sub Filtre()
Application.ScreenUpdating = False
Rows.Hidden = False
tblBD = Range("F23:Z" & [F65000].End(xlUp).Row).Value
NGroupe = 3 ' adapter
Dim Crit()
Crit = Application.Transpose([F22:L22])
For i = 1 To UBound(Crit)
Crit(i, 1) = Crit(i, 1) & "*"
Next i
For i = 1 To UBound(tblBD)
ok1 = False
For k = 1 To NGroupe
ok2 = True
For kk = 1 To UBound(Crit)
If Not tblBD(i, (k - 1) * UBound(Crit) + kk) Like Crit(kk, 1) Then ok2 = False
Next kk
If ok2 Then ok1 = True
Next k
If Not ok1 Then Rows(i + 22).Hidden = True
Next i
End Sub
Sub raz()
Rows.Hidden = False
End SubBoisgontier