Macro rapide pour organiser les cellules non vides d'un tableau

[macrobate]

Bonjour à toutes et à tous,

Je débute en VBA et ne sais pas encore optimiser mes macros.

Je cherche à synthétiser dans un onglet "récap" les valeurs non nulles contenues dans des tableaux présents dans d'autres onglets.
Dans "récap", la colonne D contient ces valeurs non nulles, les colonnes B et C contenant elles les titres des lignes et colonnes à l'intersection desquelles se trouvent ces valeurs.
En faisant une macro à base de boucles for et if qui travaillent sur les cellules, j'obtiens le bon résultat mais comme il m'arrive de devoir travailler avec des tableaux de taille importante et d'avoir de nombreux tableaux à traiter, ma macro rame.

J'aurais donc aimé savoir si vous auriez une idée pour accélérer le processus,

En pj un exemple succinct avec un seul tableau.

Merci d'avance

 

[Robert]

Re : Macro rapide pour organiser les cellules non vides d'un tableau

Bonjour Macrobate et bienvenue, bonjour le forum,

Peut-être comme ça. Le code vérifie si la ligne contient au moins une valeur, si oui elle allimente un tableau dynamique. Les données du tableau sont ensuites dispatchées dans recap :

Sub Macro2()
Dim pl As Range 'déclare la variable pl (PLage)
Dim dc As Integer 'déclare la variable dc (Dernière Colonne)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim n As Integer 'déclare la variable n (Nombre)
Dim x As Integer 'déclare la variable x (incrément)
Dim tb() As Variant 'déclare le tableau de variables indexées tb (TaBleau)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
 
With Sheets("tableau") 'prend en compte l'onglet "tableau"
    Set pl = .Range("C9:C" & .Cells(Application.Rows.Count, 3).End(xlUp).Row) 'définit la plage pl
    dc = .Cells(8, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne
    For Each cel In pl 'boucle 1 : sur toutes les cellules éditées cel de la plage pl
        'condition 1 : si le nombre de valeurs des colonnes 4 à dc de la cellule cel n'est pas vide
        If Application.WorksheetFunction.Count(.Range(.Cells(cel.Row, 4), .Cells(cel.Row, dc))) <> 0 Then
            For n = 4 To dc 'boucle 2 : sur toutes les cellules des colonnes 4 à dc
                If .Cells(cel.Row, n).Value <> "" Then 'condition 2 : si la cellule n'est pas vide
                    ReDim Preserve tb(2, x) 'redimensionne le tableau de variables tb
                    tb(0, x) = cel.Value 'récupère la valeur de la colonne B
                    tb(1, x) = .Cells(8, n).Value 'récupère la valeur de la ligne 8
                    tb(2, x) = .Cells(cel.Row, n).Value 'récupère la valeur de la cellule
                    x = x + 1 'incrémente la variable x
                End If 'fin de la condition 2
            Next n 'prochaine colonne de la boucle 2
        End If 'fin de la condition 1
    Next cel 'prochaine cellule de la boucle 1
End With 'fin de la prise en compte de l'onglet "tableau"
 
With Sheets("recap") 'prend en compte l'onglet "recap"
    For x = 0 To UBound(tb, 2) 'Boucle sur toutes les variables indéxées du tableau tb
        Set dest = .Cells(Application.Rows.Count, 2).End(xlUp).Offset(1, 0) 'définit la cellule de destination
        dest.Value = tb(0, x) 'place dans dest la variable indexée de la colonne 0
        dest.Offset(0, 1) = tb(1, x) 'place dans dest + une colonne, la variable indexée de la colonne 1
        dest.Offset(0, 2) = tb(2, x) 'place dans dest + deux colonnes, la variable indexée de la colonne 2
    Next x 'prochaine variable de la boucle
End With 'fin de la prise en compte de l'onglet "recap"
End Sub