Boucle qui ne fonctionne pas (enfin pas comme il faut)

[alex67800]

Bonjour tout le monde,

Cela fait bien longtemps que je n'ai posté une discussion sur le forum.
Toutefois je bloque sur une macro et j'aurais besoins de vos lumières.
Je m'explique:
dans ma première feuille, j'ai une liste de données (mots clés), dans la seconde, un tableau comportant par endroit ces mots clés. Ces mots clés peuvent être séparé, soit par d'autres mots, soit par un nombre variable de lignes vides.
Je souhaite masquer toutes les lignes comportant les mots clés, ainsi que toutes les lignes vides en-dessous de ceux-ci.
Pour cela j'ai fait une boucle, mais cela n'a pas l'air de focntionner.

Sub Fin()
Dim Plage, PLage2 As Range, Cellule, Cellule2 As Range
Dim wsbd, wsbd2 As Worksheet, Trouve As Boolean

Set wsbd = Sheets("S1")
Set Plage = wsbd.Range("A3:A" & wsbd.Range("A65536").End(xlUp).Row)
Set wsbd2 = Sheets("S2")
Set PLage2 = wsbd2.Range("A1:A" & wsbd2.Range("A65536").End(xlUp).Row)
  Trouve = False
  For Each Cellule In Plage
  For Each Cellule2 In PLage2
    If Cellule2.Value = Cellule.Value Then
     Range(Cellule, Cellule.Offset(-1, 0).End(xlDown)).EntireRow.Hidden = True
       
     Trouve = True
     Exit For
    End If
  
  Next Cellule2
  Next Cellule
 

End Sub

La macro me masque toutes mes lignes y compris celles comportant d'autres mots. Je pense en fait qu'il me masque la dernière ligne "non vide" avec. Je ne comrend pas pourquoi.

Je vous joint un fichier exemple.

Merci d'avance pour votre aide, et bon week-end à tous.

Edit: UN End with qui n'a pas lieu d'être dans le code.

 

[Robert]

Re : Boucle qui ne fonctionne pas (enfin pas comme il faut)

Bonjour Alex, bonjour le forum,

Peut-être comme ça :

Public Sub Mask()
Dim s1 As Object 'déclare la variable s1 (onglet S1)
Dim s2 As Object 'déclare la variable s2 (onglet S2)
Dim dl1 As Integer 'déclare la variable dl1 (Dernière Ligne 1)
Dim pl1 As Range 'déclare la variable pl1 (PLage 1)
Dim dl2 As Integer 'déclare la variable dl2 (Dernière Ligne 2)
Dim pl2 As Range 'déclare la variable pl2 (PLage 2)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim tl() As Integer 'déclare le tableau de variables tl (Tableau de Lignes)
Dim i As Integer 'déclare la variable i (incrément)

Set s1 = Sheets("S1") 'définit l'onglet s1
Set s2 = Sheets("S2") 'définit l'onglet s2
s1.Rows.Hidden = False 'affiche toutes les ligneS de l'onglet s1
dl1 = s1.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl1 de la colonne A de l'onglet s1
Set pl1 = s1.Range("A1:A" & dl1) 'définit la plage pl1
dl2 = s2.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl2 de la colonne A de l'onglet s2
Set pl2 = s2.Range("A2:A" & dl2) 'définit la plage pl2
pl1.SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True 'masque les lignes dont la cellule en A est vide
For Each cel In pl2 'boucle 1 : sur toutes les cellules de la plage pl2
    i = 0 'réinitialise la variable i
    'définit la recherche r1 (recherche la valeur de la cellule cel dans la plage pl1)
    Set r = pl1.SpecialCells(xlCellTypeVisible).Find(cel.Value, , xlValues, xlWhole)
    If Not r Is Nothing Then 'condition : si une occurrence est trouvée
        pa = r.Address 'définit l'adresse de la première occurrence trouvée
        Do 'exécute
            ReDim Preserve tl(i) 'redimensionne le tableau de variables tl
            tl(i) = r.Row 'définit la variable indexée tl(i)
            i = i + 1 'incrémente i
            Set r = pl1.SpecialCells(xlCellTypeVisible).FindNext(r) 'redéfinit la recherche r (occurrence suivante)
        Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe des occurrences ailleurs qu'en pa
        For i = 0 To UBound(tl) 'boucle 2 : sur toutes les variables du tableau tl
            Rows(tl(i)).Hidden = True 'masque la ligne correspondante
        Next i 'prochaine variable de la boucle 2
    End If 'fin de la conditon
Next cel 'prochaine cellule de la boucle 1
End Sub

 

[alex67800]

Re : Boucle qui ne fonctionne pas (enfin pas comme il faut)

Bonjour Robert, le Forum,
Ton code est trsè bien, merci.

Par contre je ne voudrais masquer les cellules vides uniquement en-dessous des mots clés.
Ton code, masque toutes les cellule vides en S1, enfin quand moi je le test.

En clair si le mot n'est pas dans les données "S2", je passe au suivant sans masquer les cellules vident en-dessous.

Merci pour ton aide et le temps passé.

@+
Alex.

 

[Robert]

Re : Boucle qui ne fonctionne pas (enfin pas comme il faut)

Bonsoir Alex, bonsoir le forum,

Le code modifié :

Public Sub Mask()
Dim s1 As Object 'déclare la variable s1 (onglet S1)
Dim s2 As Object 'déclare la variable s2 (onglet S2)
Dim dl1 As Integer 'déclare la variable dl1 (Dernière Ligne 1)
Dim pl1 As Range 'déclare la variable pl1 (PLage 1)
Dim dl2 As Integer 'déclare la variable dl2 (Dernière Ligne 2)
Dim pl2 As Range 'déclare la variable pl2 (PLage 2)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim tl() As Integer 'déclare le tableau de variables tl (Tableau de Lignes)
Dim i As Integer 'déclare la variable i (incrément)
Dim lf As Long 'déclare la variable lf

Set s1 = Sheets("S1") 'définit l'onglet s1
Set s2 = Sheets("S2") 'définit l'onglet s2
s1.Rows.Hidden = False 'affiche toutes les ligneS de l'onglet s1
dl1 = s1.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl1 de la colonne A de l'onglet s1
Set pl1 = s1.Range("A1:A" & dl1) 'définit la plage pl1
dl2 = s2.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl2 de la colonne A de l'onglet s2
Set pl2 = s2.Range("A2:A" & dl2) 'définit la plage pl2
'pl1.SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True 'masque les lignes dont la cellule en A est vide
For Each cel In pl2 'boucle 1 : sur toutes les cellules de la plage pl2
    i = 0 'réinitialise la variable i
    'définit la recherche r1 (recherche la valeur de la cellule cel dans la plage pl1)
    Set r = pl1.SpecialCells(xlCellTypeVisible).Find(cel.Value, , xlValues, xlWhole)
    If Not r Is Nothing Then 'condition : si une occurrence est trouvée
        pa = r.Address 'définit l'adresse de la première occurrence trouvée
        Do 'exécute
            ReDim Preserve tl(i) 'redimensionne le tableau de variables tl
            tl(i) = r.Row 'définit la variable indexée tl(i)
            i = i + 1 'incrémente i
            Set r = pl1.SpecialCells(xlCellTypeVisible).FindNext(r) 'redéfinit la recherche r (occurrence suivante)
        Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe des occurrences ailleurs qu'en pa
        For i = 0 To UBound(tl) 'boucle 2 : sur toutes les variables du tableau tl
            'condition : si la cellule en dessous de la ligne à masquer n'est pas vide
            If s1.Cells(tl(i), 1).Offset(1, 0).Value = "" Then
                lf = s1.Cells(tl(i), 1).End(xlDown).Row - 1 'définit la ligne de fin (ligne avant la prochaine valeur)
            Else 'sinon
                lf = tl(i) 'définit la ligne de fin (même ligne)
            End If 'fin de la condition
            If tl(i) = dl1 Then lf = dl1 'si la ligne à masquer est la dernière ligne dl1, lf = dl1
            Rows(tl(i) & ":" & lf).Hidden = True 'masque la ou les lignes correspondantes
        Next i 'prochaine variable de la boucle 2
    End If 'fin de la conditon
Next cel 'prochaine cellule de la boucle 1
End Sub

 

[alex67800]

Re : Boucle qui ne fonctionne pas (enfin pas comme il faut)

Bonsoir Robert,
Magnique cela fonctionne. PLus qu'à adapter pour mon fichier et tester en live.

Merci beaucoup.

Alex.

Toujours efficace ce forum, bravo.