Macro sur ListObject et tableaux excel

Version imprimable

Bonjour à tous,

Je me lance dans la manipulation de tableaux excel via des macros et les objets ListObject.
J'ai réalisé le code ci-dessous qui fonctionne mais qui à mon avis est loin d'être optimal (et surtout j'ai utilisé des solutions de contournement pour ce que je ne savais pas faire)

Si vous pouviez m'aider sur les points "pas propres" de mon code je suis preneur.

Le besoin :
- j'ai un onglet "Suivi" avec des lignes (j'ai déclaré un tableau "Suivi" pour ces lignes)
- j'ai un onglet "archivage" avec le même format de lignes (j'ai déclaré un tableau "Archive" pour ces lignes)
- l'idée est que quand je lance ma macro, elle boucle sur toutes les lignes du tableau "Suivi" et si le statut de la ligne est "ARCHIVE" alors je déplace la ligne dans le tableau "Archive"

Mon code :
Code:

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 Sub Lecture_tableau() ' Déclaration des variables Dim TableauSuivi, TableauArchive As ListObject Dim LignesTableauSuivi, LignesTableauArchive As ListRows ' Définit les tableaux dans la feuille de calcul Set TableauSuivi = Worksheets("SUIVI").ListObjects("Suivi") Set LignesTableauSuivi = TableauSuivi.ListRows Set TableauArchive = Worksheets("archivage").ListObjects("Archive") Set LignesTableauArchive = TableauArchive.ListRows ' Compte le nombre de lignes dans le tableau Suivi pour calculer la fin de boucle finBoucle = LignesTableauSuivi.Count ' Boucle sur toutes les lignes du tableau For i = 1 To finBoucle ' Si le statut de la ligne est "ARCHIVE" ' =>> comment travailler sur le nom de la colonne qui est "Resultat final" et non son numéro ? If TableauSuivi.Range(i, 6).Value = "ARCHIVE" Then ' Déplacer la ligne dans l'onglet archive ' =>> comment insérer dans TableauArchive et non sur la feuille "archivage" ? Sheets("archivage").Rows(4).Insert ' =>> comment copier/coller directement d'un tableau à l'autre sans travailler sur onglet excel ? ' LignesTableauArchive(1)= LignesTableauSuivi(i - 1) Sheets("SUIVI").Rows(i + 2).EntireRow.Copy Sheets("archivage").Rows(4) LignesTableauSuivi(i - 1).Delete End If Next End Sub
Les questions qui me restent après avoir fait pas mal de tests et recherches infructueuse (elles sont aussi notées dans le code en commentaire)
- comment travailler sur le nom de la colonne ("Resultat final") de mon tableau "Suivi" et non son numéro (6)
- comment insérer une ligne dans le tableau "Archive" sans devoir faire cette insertion dans excel (en gros remplacer le Sheets("archivage").Rows(4).Insert par un LignesTableauArchive.Insert
- comment copier une ligne de mon tableau "TableauSuivi" dans mon tableau "TableauArchive", quelque chose du style LignesTableauArchive(1)= LignesTableauSuivi(i - 1)

Questions subsidiaires :
- quand je travaille sur ma collection LignesTableauSuivi je suis obligé de faire i-1 sur mon indice pour être sur la bonne ligne, est-ce parce que mon indice i (utilisé dans la méthode Range) compte aussi les titres alors que la collection LignesTableauSuivi n'a pas les titres d'où le décalage de 1 ?
- pourquoi est-on obligé de préciser la worksheet dans l'instruction "Worksheets("SUIVI").ListObjects("Suivi")" puisque le tableau "Suivi" est déclaré dans tout le classeur (pas spécifiquement dans la feuille)

Merci pour toute élément de réponse que vous pourrez m'apporter

Bonjour,

avant d'attaquer l'optimisation de ta procédure, je te propose de déjà intégrer le fonctionnement des points que tu souhaites éclaircir :

Citation:

comment travailler sur le nom de la colonne ("Resultat final") de mon tableau "Suivi" et non son numéro (6)

Il faut utiliser la propriété "Index" de la propriété "ListColumns" de l'objet "ListObjects"

Ici, je récupère le numéro de colonne du champs "DATE" dans le premier tableau de la feuille active
Code:

1 2 3 4 5 Sub toto() Dim MonTableau As ListObject Set MonTableau = ActiveSheet.ListObjects(1) Debug.Print MonTableau.ListColumns("DATE").Index End Sub
Citation:

- comment insérer une ligne dans le tableau "Archive" sans devoir faire cette insertion dans excel (en gros remplacer le Sheets("archivage").Rows(4).Insert par un LignesTableauArchive.Insert

Il faut utiliser la méthode "Add" de la propriété "ListRows" de l'objet "ListObjects"

Code:

MonTableau.ListRows.Add AlwaysInsert:=False

Citation:

quand je travaille sur ma collection LignesTableauSuivi je suis obligé de faire i-1 sur mon indice pour être sur la bonne ligne, est-ce parce que mon indice i (utilisé dans la méthode Range) compte aussi les titres alors que la collection LignesTableauSuivi n'a pas les titres d'où le décalage de 1 ?

C'est parce que tu manipules le tableau dans son intgralité, or tu peux naviguer dans trois sous parties :

- Les titres : propriété HeaderRowRange de ListObjects
- Les données : propriété DataBodyRange
- Les totaux : proprité TotalsRowRange
Code:

1 2 3 4 With MonTableau Debug.Print .Rows(1).Row ' le numéro de la ligne des titres en fait Debug.Print .DataBodyRange.Rows(1).Row ' le numéro de la première ligne de données End With
Citation:

- comment copier une ligne de mon tableau "TableauSuivi" dans mon tableau "TableauArchive", quelque chose du style LignesTableauArchive(1)= LignesTableauSuivi(i - 1)

Il suffit d'insérer une ligne en bas de ton tableau et d'affecter les valeurs de la ligne de l'autre tableau

Ici, l'exemple copie une ligne du même tableau
Code:

1 2 3 4 5 6 7 8 9 10 With MonTableau ' insertion d'une ligne .ListRows.Add AlwaysInsert:=False ' la zone des données With .DataBodyRange ' les valeurs de la dernière ligne = les valeurs de la 5ème ligne en partant de la fin .Rows(.Rows.Count).Value = .Rows(.Rows.Count - 5).Value End With End With
Citation:

- pourquoi est-on obligé de préciser la worksheet dans l'instruction "Worksheets("SUIVI").ListObjects("Suivi")" puisque le tableau "Suivi" est déclaré dans tout le classeur (pas spécifiquement dans la feuille)

ce n'est pas le tableau qui est déclaré au niveau classeur, c'est son "Range"

si tu veux affecter ton tableau à une variable, sans utiliser le nom de la feuille mais plutôt directement avec son nom, tu dois passer par sa plage nommée (qui est d'étendue "Classeur") et en récupérer sa propriété ListObject
Code:

1 2 Dim MonTableau As ListObject Set MonTableau = Range("Suivi").ListObject
Je te laisse digérer tout ça, apprendre à manipuler, tu trouveras probablement des alternatives à la méthode que tu utilisais jusqu'ici ? ;)

Merci beaucoup pour ce retour qui me permet de mieux comprendre le fonctionnement de ListObject.

J'ai modifié mon code qui devient :

Code:

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
Sub Lecture_tableau()
    ' Déclaration des variables
    Dim TableauSuivi, TableauArchive As ListObject
    Dim LignesTableauSuivi, LignesTableauArchive As ListRows
 
    ' Définit les tableaux dans la feuille de calcul
    Set TableauSuivi = Worksheets("SUIVI").ListObjects("Suivi")
    Set LignesTableauSuivi = TableauSuivi.ListRows
 
    Set TableauArchive = Worksheets("archivage").ListObjects("Archive")
    Set LignesTableauArchive = TableauArchive.ListRows
 
    ' Numéro de la colonne "Resultat Final"
    numColonne = TableauSuivi.ListColumns("Resultat Final").Index
 
    ' Compte le nombre de lignes dans le tableau Suivi pour calculer la fin de boucle
    finBoucle = LignesTableauSuivi.Count
 
    ' Boucle sur toutes les lignes du tableau
    For i = 1 To finBoucle
        ' Si le statut de la ligne est "ARCHIVE"
        If TableauSuivi.Range(i, numColonne).Value = "ARCHIVE" Then
            ' Déplacer la ligne dans l'onglet archive
            LignesTableauArchive.Add (1) 'AlwaysInsert:=False
            TableauArchive.DataBodyRange.Rows(1).Value = TableauSuivi.DataBodyRange.Rows(i - 1).Value
            LignesTableauSuivi(i - 1).Delete
        End If
    Next
End Sub

Le seul problème qui persiste c'est que quand je fais l'ajout de ligne (position 1) dans le tableau d'archive, le format est celui des titres. Avant quand je copiais les lignes excel, ça recopiait le format, là comme j'utilise la propriété "value" lors de la recopie je ne copie pas le format... j'ai essayé la propriété "Format" mais elle n'est pas reconnue.

Comment puis-je faire ?

Bonjour,

il commence à y avoir de la méthode adéquate dans ton déroulé, mais ce n'est pas terminé.

affecter une destination par la valeur de la source (.Value = .Value) va effectivement représenter un "collage spécial : valeur" sans embarquer le format

dans ce cas là, il suffit de faire une copie complète (Source.Copy Destination)

ici, j'insère une ligne en premier, et j'y colle la ligne 100 de mon tableau
Code:

1 2 3 4 Dim MonTableau As ListObject Set MonTableau = ActiveSheet.ListObjects(1) MonTableau.ListRows.Add (1) 'AlwaysInsert:=False MonTableau.DataBodyRange.Rows(100).Copy MonTableau.DataBodyRange.Rows(1)
En amont, tu utilises une méthode pour chercher tes lignes sources :

- boucle de la première à la dernière ligne
- recherche de la valeur ARCHIVE
- copie vers la destination et suppression de la ligne source

Il y a un gros problème avec ta première étape : quand on boucle une plage en faisant des suppressions, il faut toujours partir du bas vers le haut !
Pourquoi ? Un exemple :

Tour 1 : ma ligne 1 contient archive, je copie et je supprime la ligne ==> ma ligne 2 devient ma ligne 1
Tour 2 : j'analyse la ligne 2 ..... et hop ! Mon ancienne ligne 2 (qui est devenue ligne 1) n'est pas analysée par la boucle

il faut partir à l'envers
Code:

1 2 ' Boucle sur toutes les lignes du tableau For i = finboucle To 1 Step -1
Ensuite, tu est encore obligé de "jongler" entre ton indice de boucle i et la position de cette ligne au sein de ton tableau (i-1) car tu n'utilises pas encore le bon outil du ListObject.
De plus, ta boucle est très large car elle analyse chaque ligne de ton tableau.

Bref, c'est galère les boucles ? Et en plus ça prend du temps ?

Et si on se passait des boucles pour faire tout ça ?

Tu peux tout à fait réduire cette boucle en effectuant un filtre automatique sur ta colonne, sur la valeur ARCHIVE
Ensuite tu travailles directement sur cette plage de résultat :

- redimensionner ton tableau de destination
- copier les résultats
- supprimer les résultats

voici un exemple
Code:

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 Sub toutoutoutou() ' facultatif, représentera le nombre de lignes contenant ARCHIVE Dim NbLig As Long ' mes deux tableaux Dim MonTableauSource As ListObject Dim MonTableauDest As ListObject Set MonTableauSource = Worksheets("MaFeuilleSource").ListObjects(1) Set MonTableauDest = Worksheets("MaFeuilleDest").ListObjects(1) With MonTableauSource ' on enlève les filtres automatiques éventuellement en place .Range.AutoFilter ' on filtre la colonne voulue sur la valeur "ARCHIVE" .Range.AutoFilter .ListColumns("MaColonne").Index, "ARCHIVE" ' représente les lignes contenant ARCHIVE With .DataBodyRange.SpecialCells(xlCellTypeVisible) ' le nombre de lignes NbLig = .Rows.Count ' on insere dans le tableau de destination autant de lignes que nécessaire MonTableauDest.DataBodyRange.Rows(1).Resize(NbLig).Insert ' on copie les résultats vers la destination .Copy MonTableauDest.DataBodyRange.Rows(1) ' on supprime les résultats de la source .EntireRow.Delete End With ' on enlève le filtre automatique .Range.AutoFilter End With End Sub
On a déjà une optimisation radicale par rapport à ton idée de départ.
Cela suffit pour des tableaux de taille raisonnable (moins de 500K lignes) et/ou qui sont triés.
Quand ça ne suffit pas, il y a encore d'autres méthodes, notamment des propositions faites par Marc-L (recherche ses réponses postées si besoin), toujours surprenantes et jolies .... mais beaucoup moins simples à maîtriser que ceci.

10/10/2016, 08h24
LG-69

Super !
Merci beaucoup pour cette solution et avec les explications en plus ce qui permet de progresser !
Je la mets en œuvre, vérifie et si tout est ok je repasse mettre en "résolu"

Encore merci.

J'ai donc modifié mon code suivant tes conseils.
2 points que j'ai du ajouter :
- la gestion des erreur sur le "With .DataBodyRange" parce que dans le cas où la sélection est vide (pas de ligne à archiver) la macro plantait => j'espère que ma gestion de l'erreur est bonne, je ne suis pas expert en la matière (en tout cas ça fait ce que je demande, plus de plantage quand la sélection est vide)
- rajouter les filtres automatique à la fin car sinon il n'y en avait plus => le mieux serait peut-être de retirer le filtrage (pas les filtres) plutôt que de supprimer/remettre les filtres ?

Code:

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
Sub Archivage()
    ' facultatif, représentera le nombre de lignes contenant ARCHIVE
    Dim NbLig As Long
 
    ' Déclaration des deux tableaux
    Dim TableauSuivi, TableauArchive As ListObject
 
    ' Définit les tableaux dans la feuille de calcul
    Set TableauSuivi = Worksheets("SUIVI").ListObjects("Suivi")
    Set TableauArchive = Worksheets("archivage").ListObjects("Archive")
 
    With TableauSuivi
        ' on enlève les filtres automatiques éventuellement en place
        .Range.AutoFilter
        ' on filtre la colonne voulue sur la valeur "ARCHIVE"
        .Range.AutoFilter .ListColumns("Resultat Final").Index, "ARCHIVE"
 
        ' représente les lignes contenant ARCHIVE
        On Error Resume Next
           With .DataBodyRange.SpecialCells(xlCellTypeVisible)
 
               ' le nombre de lignes restantes
               NbLig = .Rows.Count
               ' on insere dans le tableau de destination autant de lignes que nécessaire
               TableauArchive.DataBodyRange.Rows(1).Resize(NbLig).Insert
               ' on copie les résultats vers la destination
               .Copy TableauArchive.DataBodyRange.Rows(1)
               ' on supprime les résultats de la source
               .EntireRow.Delete
           End With
        ' on enlève le filtre automatique
        .Range.AutoFilter
        ' on remet le filtre automatique
        .Range.AutoFilter
    End With
End Sub

Bonjour,

alors, si tu as ajouté des étapes, c'est que ce que je te propose convient à ton besoin ET que tu as su apprivoiser la procédure.
ce qui est une très bonne chose.

Pour répondre à tes deux ajustements, j'aurai de mon côté opté comme ceci :

Code:

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
Sub Archivage()
    ' facultatif, représentera le nombre de lignes contenant ARCHIVE
    Dim NbLig As Long
 
    ' la colonne du tableau qui porte la valeur cherchée et la valeur qu'on cherche
    Dim MaColonne As Long, MaValeur As String
 
    ' Déclaration des deux tableaux
    Dim TableauSuivi, TableauArchive As ListObject
 
    ' Définit les tableaux dans la feuille de calcul
    Set TableauSuivi = Worksheets("SUIVI").ListObjects("Suivi")
    Set TableauArchive = Worksheets("archivage").ListObjects("Archive")
 
    With TableauSuivi
 
        MaColonne = .ListColumns("Resultat Final").Index
        MaValeur = "ARCHIVE"
 
        If Application.WorksheetFunction.CountIf(.DataBodyRange.Columns(MaColonne), MaValeur) > 0 Then
           ' on enlève les filtres automatiques éventuellement en place
           .Range.AutoFilter
           ' on filtre la colonne voulue sur la valeur "ARCHIVE"
           .Range.AutoFilter MaColonne, MaValeur
 
           ' représente les lignes contenant ARCHIVE
              With .DataBodyRange.SpecialCells(xlCellTypeVisible)
 
                  ' le nombre de lignes restantes
                  NbLig = .Rows.Count
                  ' on insere dans le tableau de destination autant de lignes que nécessaire
                  TableauArchive.DataBodyRange.Rows(1).Resize(NbLig).Insert
                  ' on copie les résultats vers la destination
                  .Copy TableauArchive.DataBodyRange.Rows(1)
                  ' on supprime les résultats de la source
                  .EntireRow.Delete
              End With
 
           ' on laisse le filtre mais on affiche toutes les données
           .Parent.ShowAllData
        End If
    End With
End Sub

J'ai introduit deux variables supplémentaires :

- MaColonne : pour stocker le numéro de la colonne où est situé archive
- MaValeur : pour stocker la valeur qu'on va rechercher

==> j'utilise ces deux valeurs pour ensuite vérifier s'il existe une ligne avec archive ... en utilisant simplement une formule "NB.SI".
C'est plus joli de faire un test, que de neutraliser les erreurs avec un On Error Resume Next

Code:

1
2
3
4
5
6
With TableauSuivi
 
        MaColonne = .ListColumns("Resultat Final").Index
        MaValeur = "ARCHIVE"
 
        If Application.WorksheetFunction.CountIf(.DataBodyRange.Columns(MaColonne), MaValeur) > 0 Then

Pour ton second ajustement, dans lequel tu as rajouté un second .Autofilter après le premier .... il est préférable dans ce cas d'utiliser la propriété .ShowAllData de l'objet WorkSheet ... qui grosso modo supprime tous les filtres existants mais laisse l'option "Filtrage Automatique" (les petites flèches sur les titres) actif :

Code:

1
2
' on laisse le filtre mais on affiche toutes les données
           .Parent.ShowAllData

.Parent permet de remonter sur l'objet parent, donc TableauSuivi.Parent = La feuille qui contient ton tableau

11/10/2016, 09h20
LG-69

Merci beaucoup, c'est parfait tout fonctionne et je pense avoir tout compris.

Explications très claires.