Boucler sur lignes filtrées

Bonjour,

J'utilise un tableau au dessus duquel plusieurs boutons activant des filtres avancés sont utilisés.

En plus de filtrer sur les lignes concernées, la macro doit également colorer les éléments.

Mon code actuel marche bien sauf si la filtre ne donne aucun résultat...

Sub Wip()
    With ActiveSheet
        FiltreBS   'Active le filtre avancé
            For Each Ligne In Range([A12], [I12].End(xlDown)).SpecialCells(xlCellTypeVisible).Rows 'Mon tableau va de A12 à J(nb de lignes variables)
                Ligne.Cells(8).Interior.ColorIndex = 12
                Ligne.Cells(9).Interior.ColorIndex = 12
            Next Ligne
    End With
End Sub

En effet si aucune ligne ne répond au filtre, la macro mouline car elle colore sans s'arrêter toutes les cases H et I des lignes vides situées en dessous du tableau ==> ça plante !

J'ai ensuite tenté de tester sur le nombre d'occurence avant de boucler mais ça plante de la même façon...

If (WorksheetFunction.Subtotal(3, Columns(3))) > 1 Then

Je pense que que le range de lignes sélectionnées dans ma boucle n'est pas adéquat.

Une solution ?

Merci pour votre aide,

waxscud

Hello,

Avec ça par exemple :

Sub passelignecache()
Dim c As Double
Dim cell As Range
c = 1
For i = 1 To 3
If Rows(c).Hidden = False Then 'si ligne cachée passe
Cells(c, 1).Interior.ColorIndex = 5
End If
c = c + 1
Next i

End Sub

+


Et pour empêcher de lancer la macro quand il n'y a aucune ligne dans le tableau, ajoute une sécurité en début de macro, par exemple :

Dim tailletab As Double

tailletab = Range("A1", Range("A1").End(xlDown)).Rows.Count 'donne la taille du tableau
If tailletab <= 0 Or tailletab >= 1048000 Then 'si atteint le chiffre des numéros de ligne de fin de classeur
End 'si la taille du tableau donne 0 ligne ou ligne de fin de classeur alors arrêt de la macro
End If

Amélioration du temps de traitement :

Ajoute en dessous des variables :

Application.ScreenUpdating = False

Au dessus de End Sub

Application.ScreenUpdating = True


Code Finale tout assemblé sur un tableau à 1 colonne avec 2200 lignes, temps de traitement moins d'une seconde.

Sub passelignecache()
Dim c As Double
Dim cell As Range
Dim tailletab As Double

Application.ScreenUpdating = False

tailletab = Range("A1", Range("A1").End(xlDown)).Rows.Count 'donne la taille du tableau
If tailletab <= 0 Or tailletab >= 1048000 Then 'taille du tableau = 0 ou atteint le chiffre des numéro de ligne de fin de classeur
End 'si la taille du tableau donne 0 ligne ou numéro de ligne de fin de classeur alors arrêt de la macro
End If

c = 2
For i = 2 To tailletab
If Rows(c).Hidden = False Then 'si ligne cachée passe
Cells(c, 1).Interior.ColorIndex = 5
End If
c = c + 1
Next i

Application.ScreenUpdating = True

End Sub

Bonjour waard,

Je n'ai pas pu tout récupérer de ton code mais j'ai réussi à m'en sortir avec ton option Ligne.Hidden.

Merci beaucoup !

Ci-dessous, mon code qui fonctionne

A+

Waxscud

Sub Wip()
    With ActiveSheet
        FiltreBS
        If (WorksheetFunction.Subtotal(3, Columns(3))) > 1 Then
            For Each Ligne In Range("A12").CurrentRegion.Offset(1).Rows
                If Ligne.Hidden = False And Ligne.Cells(9) <> "" Then
                    Ligne.Cells(8).Interior.ColorIndex = 45
                    Ligne.Cells(9).Interior.ColorIndex = 45
                End If
            Next Ligne
        Else
        End If
    End With
End Sub
Rechercher des sujets similaires à "boucler lignes filtrees"