Calcul tableau VBA

Florian53

XLDnaute Impliqué
Bonsoir à tous,

Je cherche a réaliser une macro avec 2 tableau afin d'optimiser la vitesse de calcul, mais mes faibles compétences en vba m'arrête donc je vous demande de l'aide.

Je dispose :

- D'une feuille nommée "BDD" qui est remplie avec environ 200 000 lignes sur 30 colonnes

- D'une autre feuille ou je souhaite recueillir les résultats des calculs de la macro ci dessous:

VB:
Private Sub Somme12mgFamilly()
Dim tabBDD()
Dim TabSom()
Dim wsBDD As Object
Dim wsResult As Object
Dim crit1, crit2, crit3, crit4
Dim cptBDD
Dim i As Integer

        Set wsBDD = Worksheets("BDD") ' Définition de wsBDD
        Set wsResult = Worksheets("Familly & Country") ' Définition de wsResult
       
With wsBDD
    tabBDD = Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 30)) ' Définition du tableau de BDD
End With

With wsResult

derlig = Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row  ' Dernier ligne de la feuille de travail
dercol = Cells(1, Cells.Columns.Count).End(xlToLeft).Offset(0, 0).Column ' Derniere colonne de la feuille de travail

TabSom = Range(.Cells(2, 3), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 52)) ' Définition du tableau de la feuille de travail
        For i = 2 To derlig Step 4
       
            For j = 4 To dercol

         crit1 = .Cells(i, 1)  'Pays
         crit2 = "2016"  '2016
         crit3 = "Octobre 2017" 'Octobre 2017
         crit4 = "Octobre 2016" 'Octobre 2016
         crit5 = .Cells(1, j) 'Famille
        

   
                 For cptBDD = 1 To UBound(tabBDD, 1)
                
                 '***************************************************************************************************** Total
                
                         If (tabBDD(cptBDD, 30) = crit1) And (tabBDD(cptBDD, 1) = crit2) Then
                            TabSom(i) = TabSom(i) + tabBDD(cptBDD, 11) 'Quantité 2016
                            TabSom(1 + i) = TabSom(1 + i) + tabBDD(cptBDD, 12) 'Vente 2016
                            TabSom(2 + i) = TabSom(2 + i) + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20) 'Réparation 2016
               
                         ElseIf (tabBDD(cptBDD, 30) = crit1) And (tabBDD(cptBDD, 1) = crit3) Then
                            TabSom(3 + i) = TabSom(3 + i) + tabBDD(cptBDD, 11) 'Quantité Octobre 2017
                            TabSom(4 + i) = TabSom(4 + i) + tabBDD(cptBDD, 12) 'Vente Octobre 2017
                            TabSom(5 + i) = TabSom(5 + i) + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20) 'Réparation Octobre 2017
               
                         ElseIf (tabBDD(cptBDD, 30) = crit1) And (tabBDD(cptBDD, 1) = crit4) Then
                            TabSom(6 + i) = TabSom(6 + i) + tabBDD(cptBDD, 11) 'Quantité Octobre 2016
                            TabSom(7 + i) = TabSom(7 + i) + tabBDD(cptBDD, 12) 'Vente Octobre 2016
                            TabSom(8 + i) = TabSom(8 + i) + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20) 'Réparation Octobre 2016
                '********************************************************************************************************** Fin Total
               
               
                '******************************************************************************************************** Total par famille
                         ElseIf (tabBDD(cptBDD, 1) = crit2) And (tabBDD(cptBDD, 30) = crit1) And (tabBDD(cptBDD, 24) = crit5) Then
                            TabSom(9 + i) = TabSom(9 + i) + tabBDD(cptBDD, 11) 'Quantité 2016 avec Familly
                            TabSom(10 + i) = TabSom(10 + i) + tabBDD(cptBDD, 12) 'Vente 2016 avec Familly
                            TabSom(11 + i) = TabSom(11 + i) + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20) 'Réparation 2016 avec famille
               
                         ElseIf (tabBDD(cptBDD, 1) = crit3) And (tabBDD(cptBDD, 30) = crit1) And (tabBDD(cptBDD, 24) = crit5) Then
                            TabSom(12 + i) = TabSom(12 + i) + tabBDD(cptBDD, 11) 'Quantité Octobre 2017 avec Familly
                            TabSom(13 + i) = TabSom(13 + i) + tabBDD(cptBDD, 12) 'Vente Octobre 2017 avec Familly
                            TabSom(14 + i) = TabSom(14 + i) + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20) 'Réparation Octobre 2017 avec famille
               
                        ElseIf (tabBDD(cptBDD, 1) = crit4) And (tabBDD(cptBDD, 30) = crit1) And (tabBDD(cptBDD, 24) = crit5) Then
                            TabSom(15 + i) = TabSom(15 + i) + tabBDD(cptBDD, 11) 'Quantité Octobre 2016 avec Familly
                            TabSom(16 + i) = TabSom(16 + i) + tabBDD(cptBDD, 12) 'Vente Octobre 2016 avec Familly
                            TabSom(17 + i) = TabSom(17 + i) + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20) 'Réparation Octobre 2016 avec famille
                        End If
                       
                '*********************************************************************************************************** Fin Total par famille
        Next
                              
        Next
       
        Next

    For i = 2 To derlig Step 4
   
        For j = 4 To dercol
       
         .Cells(i, j) = TabSom(i) + TabSom(3 + i) - TabSom(6 + i) 'Quantités
         .Cells(i + 1, j) = (TabSom(1 + i) + TabSom(4 + i) - TabSom(7 + i)) 'Vente
         .Cells(i + 2, j) = (TabSom(2 + i) + TabSom(5 + i) - TabSom(8 + i)) * -1 'Réparation
                  If (TabSom(1 + i) + TabSom(4 + i) - TabSom(7 + i)) = 0 Then
                     .Cells(3 + i, j) = 0
                     Else
                    .Cells(3 + i, j) = (TabSom(2 + i) + TabSom(5 + i) - TabSom(8 + i)) * -1 / (TabSom(1 + i) + TabSom(4 + i) - TabSom(7 + i)) '%E/R
                 End If
       
    Next
    Next
   
End With
   
        Set wsBDD = Nothing
        Set wsResult = Nothing
End Sub

Je souhaiterais avoir le totaux général par pays, puis les totaux par famille.
J'ai commencé cette macro, mais je pense que mon tableau "TabSom" n'est pas bon et je n'arrive à différencier les totaux généraux des totaux par famille.

Je vous transmets un fichier exemple en pièce jointe

Merci à vous pour votre aide
 

Pièces jointes

  • Test.xlsm
    157.7 KB · Affichages: 21

Dranreb

XLDnaute Barbatruc
La colonne spécifiée comme sous-groupe principal (c'est à dire le 1er) à la fonction Gigogne est toujours encore la colonne 30 où figure le nom du pays au lieu d'une colonne 31, par exemple, où vous auriez préalablement mis le numéro du pays dans l'ordre de classement que vous souhaitez.
 

Discussions similaires

Statistiques des forums

Discussions
315 091
Messages
2 116 114
Membres
112 663
dernier inscrit
Pauline243