VBA : Masquer des lignes en fonction d’une valeur contenue dans une liste

De nouveau une question au sujet de l’article du 6 Juin 2009 sur la suppression de lignes en fonction d’une valeur contenue dans un champ. C’est Décidément un sujet incontournable ! Cette fois un de nos lecteurs souhaiterait non pas supprimer les lignes mais plutôt les masquer ; et de plus il souhaite que la recherche de la valeur se passe dans toute la feuille et non pas dans une colonne unique. J’ai donc relevé le défi…

- 1 – Considérons la liste (A1 :E20), je souhaite (par exemple) masquer toute les lignes qui contiennent le mot France, quelque soit la colonne dans laquelle il se trouve.

- 2 – Voici le code, charge à vous de l’adapter…

Option Explicit
Option Base 1

Sub recherche2()
Dim i As Integer
Dim j As Integer
Dim lignefin As Integer
Dim recherche As String
Dim contenu As String
Dim tab_compare(5)
Dim compare As Long
recherche = InputBox("Veuillez entrer la valeur cherchée ?", "Welcome", "")
'La valeur saisie est transmise à la variable recherche
With ThisWorkbook.Sheets(1)
'détermination du nombre de lignes dans la base
'le nombre de colonnes est en général connu
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
lignefin = Selection.Rows.Count
'pour chaque cellule de la base
For i = 2 To lignefin + 1
For j = 1 To 5
'on parcourt, on stocke le contenu de la cellule et on compare avec la valeur saisie
Cells(i, j).Select
contenu = Cells(i, j).Value
'la fonction InStr(chaîne1, chaîne2) permet de vérifier la présence de chaîne2 dans chaîne1
'et retourne l'occurrence de la première position de la comparaison donc 0 si chaîne2 est ‘pas présente dans chaîne1
compare = InStr(1, contenu, recherche)
'pour chaque comparaison on stocke le résultat dans un tableau
If compare = 0 Then
tab_compare(j) = "Y"
Else
tab_compare(j) = "N"
End If
'il faut cinq résultats positifs pour décider de masquer la ligne
If tab_compare(1) = "Y" And tab_compare(2) = "Y" And tab_compare(3) = "Y" _
And tab_compare(4) = "Y" And tab_compare(5) = "Y" Then
Rows(i).Select
Selection.EntireRow.Hidden = True
End If
Next j
Next i
End With
End Sub

‘************************************************************
Sub Remettre()
'prévoir une macro pour réafficher les lignes
Rows("1:21").Select
Selection.EntireRow.Hidden = False
End Sub
 

- 3 – Voici le résultat après exécution de la procédure recherche2 () que j’ai attaché au bouton Recherche, la procédure Remettre() que j’ai attacher au bouton Réafficher permet de faire réapparaitre les lignes masquées.

Partager |