Discussion :

[stargates01]

Bonjour à tous,

Je bloque décidément (malgré les aides du forum) sur la façon de manipuler en vba des cellules cachées par la méthode Autofilter d'un tableau. Je veux par exemple changer la couleur de fond de cellules dont certaines appartiennent à des lignes non visibles parce que non sélectionnées par le filtre d'un tableau de type ListObject. Or quelle que soit la façon de je m'y prends, seules les cellules visibles sont affectées par mon instruction de changement de couleur. Voici un code pour illustrer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Macro1()
 
    Range("A1") = "Colonne1"
    Range("A2") = "Colonne2"
 
    For i = 2 To 5
        ActiveSheet.Cells(i, 1).Value = i - 1
    Next
 
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$A$5"), , xlYes).Name = _
        "Tableau5"
 
    ActiveSheet.ListObjects("Tableau1").ShowTableStyleRowStripes = False
 
    ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=1, Criteria1:= _
        "<>2"
    ActiveSheet.Range(Cells(3, 1), Cells(4, 2)).Interior.Color = 650650
 
End Sub

J'essaie de changer la couleur des lignes 3 et 4 de la feuille, mais comme la ligne 3 est non visible elle n'est pas affectée par ma commande... La seule façon que j'ai trouvée, mise à part le défiltrage de mon tableau, est de procéder cellule par cellule sans uitliser l'objet Range. Mais cette solution n'est pas satisfaisante dans mon projet qui comporte des tableaux beaucoup plus conséquents.

Auriez-vous une autre piste ?

Merci
Stargate

[Docmarti]

Bonjour stargates01

Je ne suis pas encore utilisateur des Tableaux ListObjects.

Mais voici quelques pistes.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Sub CreerTableauEtAjouterDonnees()
 
    Range("A1") = "Colonne1"
    Range("b1") = "Colonne2"
    Range("c1") = "Colonne3"
 
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$C$1"), , xlYes).Name = _
    "Tableau5"
 
    ActiveSheet.ListObjects("Tableau5").ShowTableStyleRowStripes = False
 
 'Ajouter des donnees
    ReDim Noms(0, 2)
 
    For i = 1 To 5
        Noms(0, 0) = i
        Noms(0, 1) = i * 2
        Noms(0, 2) = i * 3
 
        Call Tableau_AjouteRangeOuArray("Tableau5", Noms)
    Next
 
    ActiveSheet.ListObjects("Tableau5").Range.AutoFilter Field:=1, Criteria1:= _
    "<>2"
 
    Set Tbl = ActiveSheet.ListObjects("Tableau5")
 
    Set Donnees = Tbl.DataBodyRange.Cells
 
    Donnees.Cells(1, 1).Interior.Color = vbRed
 
    Donnees.Cells(2, 1).Interior.Color = vbGreen
 
End Sub
 
Sub Tableau_AjouteRangeOuArray(ByVal strTableName As String, ByRef arrayOrRange As Variant)
    Dim Tbl As ListObject
    Dim NewRow As ListRow
 
    Set Tbl = Worksheets("Feuil1").ListObjects(strTableName)
    Set NewRow = Tbl.ListRows.Add(AlwaysInsert:=True)
 
    ' Ajoute Range ou Array
    If TypeName(arrayOrRange) = "Range" Then
        NewRow.Range = arrayOrRange.Value
    Else
        NewRow.Range = arrayOrRange
    End If
End Sub

[stargates01]

Merci pour cette piste. Effectivement, comme je l'indiquais dans mon post, ça marche lorsqu'on procède cellule par cellule c'est-à-dire sans utiliser l'objet Range. Mais justement je voudrais éviter cette méthode car mon vrai tableau a plus de 80.000 lignes et 20 colonnes : si je veux colorer l'ensemble d'une plage (par exemple A2:T10000, procéder cellule par cellule va être long. Et si je procède en utilisant Range("A2:T10000") , seules les lignes visibles sont recolorées.

Stargates

[patricktoulon]

Bonjour
fait une recherche du coté de (xlCellTypeVisible)

[Philippe Tulliez]

Bonjour,
Tu dois utiliser la propriété DataBodyRange de l'objet ListObject
Exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub Test()
  Dim myTable As ListObject
  Set myTable = ActiveSheet.ListObjects("MonTableau")
  myTable.Range.AutoFilter field:=4, Criteria1:="F"
  myTable.DataBodyRange.Cells(5, 1).Font.Color = vbRed
End Sub

Attention que le n° de la ligne correspond à la ligne de cette propriété (décalage de 1)

[Docmarti]

Merci pour cette piste. Effectivement, comme je l'indiquais dans mon post, ça marche lorsqu'on procède cellule par cellule c'est-à-dire sans utiliser l'objet Range. Mais justement je voudrais éviter cette méthode car mon vrai tableau a plus de 80.000 lignes et 20 colonnes : si je veux colorer l'ensemble d'une plage (par exemple A2:T10000, procéder cellule par cellule va être long. Et si je procède en utilisant Range("A2:T10000") , seules les lignes visibles sont recolorées.

Stargates

Comme le dit Philippe, DataBodyRange te donne accès à toutes les cellules du tableau sauf la ligne de titres.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Set Tbl = ActiveSheet.ListObjects("Tableau5")
 
    Tbl.DataBodyRange.Cells.Range("A1:A3000").Interior.Color = vbGreen
 
'ou
 
    Set Donnees = Tbl.DataBodyRange.Cells
 
    Donnees.Cells.Range("A1:A3000").Interior.Color = vbGreen
 
    Donnees.Cells(1, 1).Interior.Color = vbRed

[stargates01]

Bon, je ré-ouvre le fil car finalement la solution proposée ne convient pas, ou alors je n'ai peut-être pas bien appliquée ? du coup, pour les courageux qui voudront bien s'intéresser au problème je joints mon fichier exemple.

Comme vous le verrez l'unique macro de ce classeur a pour but de colorer les cellules d'une liste (ListObject) en fonction de chaque changement de valeur d'une colonne (IrisRef). Et mon problème est que je voudrais que cette macro marche que mon tableau ait un filtre actif ou non... or, comme le montre ma macro, ça ne marche pas bien quand il y a un filtre. Pour le constater il faut lancer la macro et défilter le tableau : il subsiste des cellules en vert alors qu'elles devraient toutes être blanches ou bleues.


Voici le code la macro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Sub Mise_en_Forme_Tableau()
 
    Dim NTable As ListObject
    Dim NPlage As Range
 
    Set NTable = ActiveWorkbook.ActiveSheet.ListObjects(1)
 
    'Tri le Tableau sur la colonne [IrisRef]
 
         NTable.Sort.SortFields.Clear
         NTable.Sort.SortFields. _
             Add Key:=Range(NTable.Name & "[IrisRef]"), SortOn:=xlSortOnValues, Order:= _
             xlAscending, DataOption:=xlSortTextAsNumbers
         With NTable.Sort
             .Header = xlYes
             .MatchCase = False
             .Orientation = xlTopToBottom
             .SortMethod = xlPinYin
             .Apply
         End With
 
        NTable.Range.AutoFilter
        NTable.DataBodyRange.Interior.Color = vbGreen
 
        NTable.Range.AutoFilter Field:=1, Criteria1:="IRIS"
 
    'Change la couleur des cellules à chaque rupture du champ IrisRef
 
        NTable.ShowTableStyleRowStripes = False
 
        Nrow1 = NTable.DataBodyRange.Cells(1, 1).Row
        Nrow2 = Nrow1
        Nrow3 = Nrow2
        NFlag = -1
        NColor = 16777215
        For i = Nrow1 To NTable.DataBodyRange.End(xlDown).Row
            If Cells(i + 1, NTable.ListColumns("IrisRef").Range.Column) <> Cells(i, NTable.ListColumns("IrisRef").Range.Column) Then
                Naddress = NTable.ListColumns(1).Range.Cells(Nrow2 - Nrow1 + 1, 1).Address & ":" & NTable.ListColumns(NTable.ListColumns.Count).Range.Cells(Nrow3 - Nrow1 + 1, 1).Address
                NTable.DataBodyRange.Range(Naddress).Cells.Interior.Color = NColor
                Nrow2 = Nrow3 + 1
                Nrow3 = Nrow2
                NColor = NColor + 923939 * NFlag
                NFlag = -NFlag
            Else
                Nrow3 = Nrow3 + 1
            End If
        Next i
 
End Sub

Merci pour votre aide

[Docmarti]

Bonjour stargates01;

Première chose, quand on travaille avec un objet ListObject, on doit oublier complètement l'objet ActiveSheet. Car il n'y a aucune corrélation entre le cells(1,1) de l'un et le cells(1,1) de l'autre.

Je te suggère de tester ton code sur un tableau non filtré et d'utiliser à outrance la commande SELECT pour vérifier que ton code est correct.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
For i = 1 To NTable.DataBodyRange.Rows.Count
          Set r2 = NTable.DataBodyRange.Cells(i + 1, 3)
          Set r1 = NTable.DataBodyRange.Cells(i, 3)
          r1.Select
 
          If r1 <> r2 Then
           r1.Select
           stop
          end if
       next

[stargates01]

J'ai testé mon code lorsque le tableau n'est pas filtré et il fonctionne dans ce cas correctement. En revanche quand je filtre le tableau ça ne marche pas ou plutôt ça marche les premières lignes puis ça ne marche plus, c'est à dire que au bout d'un certain nombre de lignes, les cellules non visibles ne sont pas affectées par le changement de couleur. J'ai testé en pas a pas pour vérifier que la commande de changement de couleur passait bien sur les lignes non visibles, ce qui est bien le cas, mais les cellules ne changent pas de couleur contrairement aux cellules visibles.

Merci

[Docmarti]

Comme il arrive quelquefois dans Excel, le résultat est différent selon que la commande en VBA affecte plusieurs cellules ou une seule cellule.

La solution semble être :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For Each c In NTable.DataBodyRange.Range("A" & debut & ":C" & fin)
                 c.Interior.Color = NColor
Next

[stargates01]

Merci de ton éclairage. Un peu déçu du comportement erratique d'Excel sur ce coup là... Je vais procéder cellule par cellule mais je trouve ça pas terrible.

Encore merci
Stargates01

[Philippe Tulliez]

Bonjour,
Je ne sais pas si tu y as pensé car je ne l'ai pas vu dans ta procédure mais afin d'augmenter la vitesse d'exécution du code. Il y a une instruction à placer avant les procédures d'écritures et à la fin. Cela désactive l'affichage.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Application.ScreenUpdating = False ' Avant l'exécution
'
' Code 
'
Application.ScreenUpdating = True ' Après l'exécution

[stargates01]

Oui, merci je l'utilise assez systématiquement. Je me soucie de la performance car mon tableau peut atteindre 100k lignes et une vingtaine de colonnes, c'est pourquoi je voulais éviter de procéder cellule par cellule.

[Docmarti]

Voici une solution alternative possiblement intéressante basée sur la sauvegarde et la restauration des filtres.

[stargates01]

Merci DocMarti. Cette routine me sera utile. Cependant compte tenu de la taille de mon tableau le nombre de valeurs sur certains filtres peuvent dépasser les 10.000 et je crains que mes variables array s'essouflent... je vais quand même essayer.