Calcul tableau VBA

Florian53 · 4 Décembre 2017

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

Florian53 · 5 Décembre 2017

J'ai réalisé une macro "ordinaire" qui fonctionne mais celle ci prends environ 3minutes, à priori si je passerais avec des tableaux le code prendrait beaucoup moins de temps.
Donc j'ai essayé de réaliser le code (1er post), mais mes compétences actuelles en VBA me limite.

Le fonctionnement attendu par la macro est :

En colonne "C" de la feuille "Familly & Country" --> Les totaux par pays en fonction des 3 critères :

- Quantité : Colonne "K"
- Ventes : Colonne "L"
- Réparation : Addition des Colonnes "N, O, P, R, T"
- % % Ventes / Réparation : Divison de la colonne "L" par Colonnes "N, O, P, R, T"

* La colonne "C" est juste l'addition de la colonne "D" à Dercol .

Pour les colonnes de "D" à dercol de la feuille "Familly & Country" --> Les totaux par pays et par familles en fonction des 3 mêmes critères ci dessus.

Pouvez vous me guider sur le fonctionnement des tableaux afin de modifier la macro ?

Merci à vous

Dranreb · 5 Décembre 2017

Bonjour.
L'ordre des titres est à respecter, ou bien vous y souhaiteriez un inventaire classé de gauche à droite de ce qu'on trouve dans la BDD ?

Florian53 · 5 Décembre 2017

Bonjour et merci de ta réponse Dranreb ,

Je dispose d'une macro qui me liste au préalable les familles dans l'ordre croissant en fonction des réparations pour le top1 des pays .

Donc il faudrait juste que la macro respecte l'ordre des cellules (1,j) .

Dranreb · 5 Décembre 2017

Zut, je l'ai déjà écrit en utilisant la fonction DicInvent de la fourniture GigIdx…
Mais on pourrait facilement remplir le Dictionary d'après les titres. Mais je laisserai comme c'est pour le moment…
Ce ne serait pas "% Réparation / Ventes" plutôt que "% Ventes / Réparation" ?

Dranreb · 5 Décembre 2017

Le premier jet de ma procédure, avec GigIdx en référence dans le projet :

VB:

Option Explicit

Private Sub Somme12mgFamilly()
Dim Dic As New Dictionary, ColGig As Collection, T(), Pays As SsGr, Article As SsGr, _
   L&, C&, S As Double
Set Dic = GigIdx.DicInvent(Worksheets("BDD").[A2:AD2], 24, ColDép:=4)
Set ColGig = Gigogne(Null, 30, 24)
ReDim T(1 To 1 + ColGig.Count * 4, 1 To 4)
GigIdx.VerserTitres T, Dic
L = 1: T(1, 3) = "Total"
Worksheets("Familly & Country").[A18].Resize(UBound(T, 1), UBound(T, 2)).Value = T
For Each Pays In ColGig
   L = L + 1
   T(L, 1) = Pays.Id: T(L, 2) = "Quantité": T(L + 1, 2) = "Ventes"
   T(L + 2, 2) = "Réparation": T(L + 3, 2) = "% Ventes / Réparation"
   For Each Article In Pays.Co
      C = Dic(Article.Id)
      S = Article.somme(11): T(L, C) = T(L, C) + S: T(L, 3) = T(L, 3) + S
      S = Article.somme(12): T(L + 1, C) = T(L + 1, C) + S: T(L + 1, 3) = T(L + 1, 3) + S
      S = Article.somme(14) + Article.somme(15) + Article.somme(16) + Article.somme(18) + Article.somme(20)
      T(L + 2, C) = T(L + 2, C) + S: T(L + 2, 3) = T(L + 2, 3) + S
      Next Article
   For C = 3 To UBound(T, 2)
      If T(L + 1, C) <> 0 And T(L + 2, C) <> 0 Then T(L + 3, C) = T(L + 2, C) / T(L + 1, C)
      Next C
   L = L + 3: Next Pays
With Worksheets("Familly & Country")
   .Cells.ClearContents
   .[A1].Resize(UBound(T, 1), UBound(T, 2)).Value = T
   End With
End Sub

Florian53 · 5 Décembre 2017

Super, merci à toi.

Je n'ai pas encore essayé ta solution, car je me pose une question, j'aimerais que mon fichier soit utilisable par n'importe qui, est ce que le complément de GigIdx sera à installer sur tout les postes susceptible d'ouvrir le fichier ?

Dranreb · 5 Décembre 2017

S'il est sur un répertoire d'un réseau, on devrait pouvoir y mettre le complément aussi.
Si ça pose trop de problème on peut installer le module de service MGigogne et le module de classe SsGr.

Florian53 · 5 Décembre 2017

Le fichier que je souhaite réaliser, sera certainement utilisé par des personnes que je ne connais pas dans mon groupe, je ne pourrais pas imposer à ces personnes une installation de complément sur leur poste.

Existe -il une solution ou l'opérateur aura juste a activer les macros pour pouvoir réaliser les calculs ?

Dranreb · 6 Décembre 2017

Je vous ai indiqué une possibilité au poste précédent. Vous ne m'avez pas répondu au sujet de l'hypothèse qu'il l'ouvrent depuis un dossier réseau, mais je suppose que oui, sinon vous auriez bien à installer le classeur chez les utilisateurs, alors vous pourriez bien en profiter pour installer aussi le complément.
Si vous installez le complément dans le même dossier que celui ou est le classeur, ça devrait aller, non ?
À tout hasard je joins quand même le classeur équipé des modules de service nécessaires. Ne perdez pas pour autant le GigIdx.xlsm parce que c'est le seule à contenir la feuille d'aide à l'utilisation.

Florian53 · 6 Décembre 2017

Bonjour Dranreb,

Effectivement le fichier sera sur un réseau, j'ai testé votre fichier joint sur ma base de données. Vitesse de calcul incroyable .

Mais en voyant les résultats, je me rends comte que ma demande n'était pas complète.
Je souhaiterais avoir un classement dans l'ordre décroissant des pays en fonction de la valeur des réparations.

Et par la suite classé les familles toujours en décroissant par rapport au réparation par rapport au TOP1 des pays ( "A2").

Est ce possible d'avoir aussi les critères accessible comme dans mon 1er post ?

VB:

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

[/code]

La formule attendu est : "2016 + Octobre 2017 - Ocotbre2016" mais j'ai indiqué ces critères pour l'exemple, mais les vrais critères seront sous la forme:

crit2 = "Réel ...." ' car l'année peut varier
crit3 = "AAA BBB 010.2017" ' le mois et l'année peut varier
crit4 = "AAA BBB 010.2016" ' le mois et l'année peut varier

Le but est de calculer un 12 mois glissant en fonction de la demande et de la BDD disponible.
Je ne sais pas si le code est modifiable dans ce sens ?
Encore merci à toi pour l'aide que tu m'apportes

Dranreb · 6 Décembre 2017

Bonjour.
Non, désolé je ne comprends rien.
Pour 3 pays il me semble que l'ordre importe peu. On voit assez vite où est le total des réparations les plus élevées.
Cela dit, Gigogne peut accepter des colonnes de critères à présenter en ordre décroissant. Il suffit de mettre un signe moins devant le numéro de la colonne.

Florian53 · 6 Décembre 2017

La BDD fournit dans le fichier est réduit considérablement, ma BDD que je dispose à 55 pays et environ 50 familles soit plus 100 000 lignes. c'est pour ça que je souhaiterais avoir un classement dans mon code " Ordinaire" je dispose de 3 macro :

- 1 qui me liste les pays par ordre décroissant en fonction de la valeur des réparations
- 1 qui me liste les familles par ordre décroissant en fonction de la valeur des réparations pour le Top1 des familles

- 1 qui me remplit intégralement le tableau en fonction de la colonne "A2:A & derlign" et "C1 à C & dercol"

Dranreb · 6 Décembre 2017

Au lieu de la colonne contenant le pays il faut donner comme critère de regroupement à Gigogne une colonne contenant le numéro d'ordre du pays dans le classement souhaité, et, pour restituer quand même le nom du pays, au lieu de T(L,1) = Pays.Id mettre T(L, 1) = Pays.Co(1).Co(1)(30)

Florian53 · 6 Décembre 2017

J'ai remplacer la ligne comme vous me l'avez préconisé, mais les pays ne se classent par ordre décroissant.

Je souhaiterais par exemple, si la france à la valeur 1000 en réparation et que la belgique 700. La france soit en 1er (A2) et la belgique en 2eme ( A6).

VB:

Sub Somme12mgFamilly()
Dim Dic As New Dictionary, ColGig As Collection, T(), Pays As SsGr, _
    Article As SsGr, L As Long, C As Long, S As Double ',M as Currency ?
Set Dic = MGigogne.DicInvent(Worksheets("BDD").[A2:AD2], 24, ColDép:=4)
Set ColGig = Gigogne(Null, 30, 24)
ReDim T(1 To 1 + ColGig.Count * 4, 1 To 4)
MGigogne.VerserTitres T, Dic
L = 1: T(1, 3) = "Total"
Worksheets("Familly & Country").[A18].Resize(UBound(T, 1), UBound(T, 2)).Value = T
For Each Pays In ColGig
   L = L + 1
   T(L, 1) = Pays.Co(1).Co(1)(30): T(L, 2) = "Quantité": T(L + 1, 2) = "Ventes"
   T(L + 2, 2) = "Réparation": T(L + 3, 2) = "% Ventes / Réparation"
   For Each Article In Pays.Co
      C = Dic(Article.Id)
      S = Article.Somme(11): T(L, C) = T(L, C) + S: T(L, 3) = T(L, 3) + S
      S = Article.Somme(12): T(L + 1, C) = T(L + 1, C) + S: T(L + 1, 3) = T(L + 1, 3) + S
      S = Article.Somme(14) + Article.Somme(15) + Article.Somme(16) + Article.Somme(18) + Article.Somme(20)
      T(L + 2, C) = T(L + 2, C) + S: T(L + 2, 3) = T(L + 2, 3) + S
      Next Article
   For C = 3 To UBound(T, 2)
      If T(L + 1, C) <> 0 And T(L + 2, C) <> 0 Then T(L + 3, C) = T(L + 2, C) / T(L + 1, C)
      Next C
   L = L + 3: Next Pays
With Worksheets("Familly & Country")
   .Cells.ClearContents
   .[A1].Resize(UBound(T, 1), UBound(T, 2)).Value = T
   End With
End Sub

Calcul tableau VBA

Florian53

XLDnaute Impliqué

Pièces jointes

Florian53

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

Florian53

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

Florian53

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

Florian53

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

Pièces jointes

Florian53

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

Florian53

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

Florian53

XLDnaute Impliqué

Discussions similaires