Macro Array pour accélérer des Sous totaux d'un classeur dans une autre feuille.

[Broch002]

Bonjour,

Je reviens vers vous, qui m'avez déjà tellement apporté de solutions.

Voila j'ai un classeur pouvant contenir 487 références sur 50 000 lignes. Je souhaites sur une autre feuilles du classeur générer des sous totaux par références (je ne peux pas passer par un tableau croisé dynamique).
Jusqu’à présent, je copiais par macro la feuille , la triais puis lançait toujours par macro la fonction sous total, mais là la macro devient terriblement longue plus le nombre de ligne et de référence augmentent.

j'ai chercher sur la toile et découvert la fonction array qui augmenterait énormément le vitesse des macros. J'ai téléchargé un fichier test et essayé de l'adapter à mon problème, mais je n'y arrive pas. pouvez-vous m'aider?

Voici la macro qui plante:
Sub TRIER_PAR_REFERENCE()
'macro trouvée sur Internet et modifié
Dim Tblo1() As Variant
Dim orders As ListObject
Dim Cel As Range
Dim f As Integer
Workbooks("test.xlsm").Activate
Set orders = Sheets("A-1").ListObjects("Tableau1")
For Each Cel In orders.DataBodyRange.Columns(1).Cells
If Cel.Value = "Jean" Then
f = f + 1
ReDim Preserve Tblo1(1 To 13, 1 To f)
Tblo1(1, f) = Cel.Offset(0, -2).Value
Tblo1(2, f) = Cel.Offset(0, -1).Value2
Tblo1(3, f) = Cel.Value
Tblo1(4, f) = Cel.Offset(0, 1).Value
Tblo1(5, f) = Cel.Offset(0, 2).Value
End If
Next Cel

With Sheets("A-1")
.Columns("H:K").Copy Destination:=Sheets("Réalisation").[B2]
End With

Workbooks("test.xlsm").Activate
Set orders = Sheets("A-1").ListObjects("Tableau1")
For Each Cel In orders.DataBodyRange.Columns(1).Cells
If Cel.Value = "Charles" Then
f = f + 1
ReDim Preserve Tblo1(1 To 13, 1 To f)
Tblo1(1, f) = Cel.Offset(0, -2).Value
Tblo1(2, f) = Cel.Offset(0, -1).Value2
Tblo1(3, f) = Cel.Value
Tblo1(4, f) = Cel.Offset(0, 1).Value
Tblo1(5, f) = Cel.Offset(0, 2).Value
End If
Next Cel

With Sheets("A-1")
.Columns("H:K").Copy Destination:=Sheets("Réalisation").[B3]
End With

Workbooks("test.xlsm").Activate
Set orders = Sheets("A-1").ListObjects("Tableau1")
For Each Cel In orders.DataBodyRange.Columns(1).Cells
If Cel.Value = "Christian" Then
f = f + 1
ReDim Preserve Tblo1(1 To 13, 1 To f)
Tblo1(1, f) = Cel.Offset(0, -2).Value
Tblo1(2, f) = Cel.Offset(0, -1).Value2
Tblo1(3, f) = Cel.Value
Tblo1(4, f) = Cel.Offset(0, 1).Value
Tblo1(5, f) = Cel.Offset(0, 2).Value
End If
Next Cel

With Sheets("A-1")
.Columns("H:K").Copy Destination:=Sheets("Réalisation").[B4]
End With

End Sub

 

[Broch002]

Re : Macro Array pour accélérer des Sous totaux d'un classeur dans une autre feuille

Bonjour, pierrejean.

est-il possible également qu'a chaque lancement d'une des stats liées a l'intitulé d'une colonnes, le fichier crée en remplacement de la stat précédente le soit sur la feuille "Réalisation".

Merci d'avance.