Calcul tableau VBA

Bonsoir à tous,

Je cherche a réaliser une macro avec 2 tableau afin d'optimiser la vitesse de calcul, 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:

Private Sub Somme12mgFamilly()
Dim tabBDD()
Dim TabSom(0 To 250)
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(1) = 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

            crit1 = .Cells(i, 1)  'Ville
            crit2 = Sheets("Données").Cells(4, 2)  '2016
            crit3 = Sheets("Données").Cells(5, 2) 'Octobre 2017
            crit4 = Sheets("Données").Cells(6, 2) 'Octobre 2016

                    For cptBDD = 1 To UBound(tabBDD, 1) 

                            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
                  End If

                Next

        Next

    For i = 2 To derlig Step 4

            .Cells(i, 3) = TabSom(i) + TabSom(3 + i) - TabSom(6 + i) 'Quantités
            .Cells(i + 1, 3) = (TabSom(1 + i) + TabSom(4 + i) - TabSom(7 + i)) 'Vente
            .Cells(i + 2, 3) = (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, 3) = 0
                        Else
                    .Cells(3 + i, 3) = (TabSom(2 + i) + TabSom(5 + i) - TabSom(8 + i)) * -1 / (TabSom(1 + i) + TabSom(4 + i) - TabSom(7 + i)) '%E/R
                    End If

    Next

End With

        Set wsBDD = Nothing
        Set wsResult = Nothing
End Sub

La macro bug sur la déclaration de TbSom, sur ma feuille de travail la variable "derlign" vaut 220 mais celle ci veut varier.

Je débute avec les tableaux en VBA, et j'avoue que je galère un petit peu

Pouvez vous m'indiquer les erreurs s'il vous plaît? merci à vous

Bonjour

La macro bug sur la déclaration de TbSom

Essaie ainsi :
TabSom = Range(.Cells(2, 3), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 52))

Bye !

Merci gmb,

Maintenant, dés que je rentre dans une phase ou les critères correspondent et que la valeur de i=2 j'ai une erreur:

"L'indice n'appartient pas à la selection"

 TabSom(i) = TabSom(i) + tabBDD(cptBDD, 11)

Tu devrais joindre ton fichier.

S'il est trop gros, passe par www.cjoint.com

Bye !

Voici en pièce jointe un fichier très fortement réduit pour l'exemple.

20test.xlsm (283.84 Ko)

Je me suis trompé dans le premier code car celui ne prenait pas en compte les totaux par familles:

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

Ce code est faux, car je n'arrive pas à différencier la colonne 2 "Totaux" des autres "totaux par famille" de 3 à dercol.

Bonjour

Bonjour

Tu définis tabBDD et TabSom comme des plages de cellules.

Ces 2 variables tableau ont donc deux dimensions. La première correspond aux lignes et la deuxième aux colonnes.

A l’utilisation on doit donc retrouver ces deux entités sous la forme TabSom (lignes, colonnes)

VBA ne comprend pas quand tu écris : TabSom (i) ou encore TabSom(3 + i). Il manque un argument.

OK ?

Il m’est difficile de corriger moi-même ta macro car je ne sais pas où tu veux en venir.

Bye !

Merci pour ta réponse,

J'aimerais avoir une macro qui fonctionne avec des tableaux afin que celle ci renseigne les valeurs demandées dans la feuil "Family & Country" par rapport à la BDD.

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"

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

J'ai réussi à faire une macro "Ordinaire" mais celle ci prends beaucoup de temps, et à priori avec des tableaux le temps d’exécution serait considérablement réduit.

Un essai à tester. Te convient-il ?

Bye !

23test-v1.xlsm (294.59 Ko)

Merci, alors je suis bluffé par la vitesse d’exécution de la macro, comme quoi quand les expérimenté VBA tape de la macro, les débutants observent

Pour le fonctionnement, j'ai oublié de préciser que je voudrais que les pays soit rangés dans l'ordre décroissant par rapport à la valeur de "Réparation" et ranger aussi les familles par ordre décroissant par rapport au Top1 des pays:

Par exemple : si le Pays qui a le plus de réparation est la France, je voudrais que celui apparaissent en 1er, et que le listing des familles soit fait en décroissant toujours par le critère "Réparation" seulement sur la France.

En exécutant le code sur ma BDD, j'ai l'impression que les résulats ne sont pas bons:

Le calcul voulu est : Année 2016 + Octobre 2017 - Octobre 2016

Est ce code :

 tablor(ln, 3) = tablor(ln, 3) + tabloB(i, 1) 

qui fait cette étape de calcul ?

Encore un grand merci à toi pour ton aide

Bonjour

Le calcul voulu est : Année 2016 + Octobre 2017 - Octobre 2016

Cela, ce n'était pas présisé au départ.

Si tu veux obtenir ce résultat, il te faudrait décomposer ton tableau sur 3 feuilles différentes : une avec les données de 2016, une avec celles de oct 2017 et une 3° avec celles de octobre 2016 et faire tourner la macro avec chacune d'entre elles pour avoir 3 résultats intermédiaires.

Quant à faire un classement comme tu le souhaites, ce ne sera envisageable que lorsque tu auras les résultats de chacune des 3 feuilles précédentes. Encore qu'il sera peut-être alors plus simple de faire un classement à la main...

Bye !

Ok, je vais essayer d'adapter cette macro afin qu'elle insère 3 feuilles pour faire le calcul.

Est ce possible pour toi, de modifier le code afin que je dispose d'un "range" pour modifier le critère de la période , un peu dans le même esprit que dans mon 1er post : " crit1 = .Cells(i, 1)"

Je voudrais savoir, si je ne voudrais que la macro ne remplisse pas les pays & les familles automatiquement est ce qu'il faut juste que j'enleve cette partie du code ?

    'On reporte les titres sur le tableau des résultats
    Range("D1").Resize(1, dicoF.Count) = dicoF.keys
    Range("A2").Resize(dicoP.Count, 1) = Application.Transpose(dicoP.keys)

Car je dispose déjà d'une macro qui fonctionne et qui ne prends pas de temps qui classe les pays en fonction des réparations et me classe également les familles par rapport au top1 des pays.

J'aimerais du coup que ta macro remplisse simplement le tableau en prenant en compte les cellules de "A2:A & derlign" et "D1:D & Dercol" sans les modifier. Comme ça j'exécuterais ma macro afin qu'elle remplisse les entêtes avant d’exécuter la tienne

Merci à toi

Bonjour à tous,

Je viens d'ajuster ta macro à mon fichier, tout à l'air de fonctionner et en plus à une vitesse SuperSonic

La macro ajoute 3 feuilles pour les 3 différents calculs, les 3 feuilles ont les mêmes dimensions, maintenant mon problème est de réaliser une macro pour le calcul:

Feuil1.Range .. + Feuil2.Range - Feuil3.Range

Je ne vois pas comment créer une macro qui applique cette étape de calcul à tous le tableau.

Voici mes 2 macros :

Créations des entêtes triée

 Sub Entête()

    Dim tabloB, tabloProv, Tablofamille, tablor, dicoF As Object, dicoP As Object, cléF, cléP
    Dim i&, j&, nbP&, nbF&, ln&, nom$, v
    Dim som
    Dim crit1, crit2, crit3, crit4, crit5
    Dim cptBDD

    Set wsResult = Worksheets("Données")

    tabloB = Sheets("BDD").Range("A2:AD" & Sheets("BDD").Range("A" & Rows.Count).End(xlUp).Row)
    Set dicoF = CreateObject("Scripting.Dictionary")
    Set dicoP = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    Cells.ClearContents

    'Liste des familles et des pays
    For i = 1 To UBound(tabloB, 1)
        If tabloB(i, 24) <> "" Then dicoF(tabloB(i, 24)) = ""
        If tabloB(i, 30) <> "" Then dicoP(tabloB(i, 30)) = ""
    Next i

    'On reporte les titres sur le tableau des résultats
    With wsResult
    .Columns("E:K").ClearContents
    .Range("I1").Resize(dicoF.Count, 1) = Application.Transpose(dicoF.keys)
    .Range("E1").Resize(dicoP.Count, 1) = Application.Transpose(dicoP.keys)

        derlgnP = Sheets("Données").Cells(Rows.Count, 5).End(xlUp).Offset(0, 0).Row

        For i = 1 To derlgnP ' Boucle qui sert à trier les Pays en fonction de Exhange & Repair
            som1 = 0
            som2 = 0
            som3 = 0

            crit1 = Sheets("Données").Cells(i, 5)  'Country
            crit2 = Sheets("Données").Cells(4, 2)  'Réel
            crit3 = Sheets("Données").Cells(5, 2) 'YTD ACT n
            crit4 = Sheets("Données").Cells(6, 2) 'YTD ACT n-1

            For cptBDD = 1 To UBound(tabloB, 1)

                        If (tabloB(cptBDD, 30) = crit1) And (tabloB(cptBDD, 1) = crit2) Then
                        som1 = som1 + tabloB(cptBDD, 14) + tabloB(cptBDD, 15) + tabloB(cptBDD, 16) + tabloB(cptBDD, 18) + tabloB(cptBDD, 20) 'Exchange & Repair

                        ElseIf (tabloB(cptBDD, 30) = crit1) And (tabloB(cptBDD, 1) = crit3) Then
                        som2 = som2 + tabloB(cptBDD, 14) + tabloB(cptBDD, 15) + tabloB(cptBDD, 16) + tabloB(cptBDD, 18) + tabloB(cptBDD, 20) 'Exchange & Repair

                        ElseIf (tabloB(cptBDD, 30) = crit1) And (tabloB(cptBDD, 1) = crit4) Then
                        som3 = som3 + tabloB(cptBDD, 14) + tabloB(cptBDD, 15) + tabloB(cptBDD, 16) + tabloB(cptBDD, 18) + tabloB(cptBDD, 20) 'Exchange & Repair
                        End If
            Next
                    .Cells(i, 6) = som1 + som2 - som3 'quantities
        Next

    With Sheets("Données").Range("E1:F" & Sheets("Données").Range("F" & Rows.Count).End(xlUp).Row)  ' Trie le tableau en fonction des valeurs des Réparations
    'Tri le résultat du filtre en ordre croissant
    .Sort .Item(2, 2), xlAscending, , , , , , xlNo
    End With

        derlgnF = Sheets("Données").Cells(Rows.Count, 9).End(xlUp).Offset(0, 0).Row
        For j = 1 To derlgnF ' Boucle qui sert à trier les Pays en fonction des Réparations

            som1 = 0
            som2 = 0
            som3 = 0

            crit1 = Sheets("Données").Cells(j, 9)  'Familly
            crit2 = Sheets("Données").Cells(4, 2)  'Réel
            crit3 = Sheets("Données").Cells(5, 2) 'YTD ACT n
            crit4 = Sheets("Données").Cells(6, 2) 'YTD ACT n-1
            crit5 = Sheets("Données").Cells(1, 5) ' Country Top1

            For cptBDD = 1 To UBound(tabloB, 1)

                        If (tabloB(cptBDD, 30) = crit5) And (tabloB(cptBDD, 1) = crit2) And (tabloB(cptBDD, 24) = crit1) Then
                        som1 = som1 + tabloB(cptBDD, 14) + tabloB(cptBDD, 15) + tabloB(cptBDD, 16) + tabloB(cptBDD, 18) + tabloB(cptBDD, 20) 'Exchange & Repair

                        ElseIf (tabloB(cptBDD, 30) = crit5) And (tabloB(cptBDD, 1) = crit3) And (tabloB(cptBDD, 24) = crit1) Then
                        som2 = som2 + tabloB(cptBDD, 14) + tabloB(cptBDD, 15) + tabloB(cptBDD, 16) + tabloB(cptBDD, 18) + tabloB(cptBDD, 20) 'Exchange & Repair

                        ElseIf (tabloB(cptBDD, 30) = crit5) And (tabloB(cptBDD, 1) = crit4) And (tabloB(cptBDD, 24) = crit1) Then
                        som3 = som3 + tabloB(cptBDD, 14) + tabloB(cptBDD, 15) + tabloB(cptBDD, 16) + tabloB(cptBDD, 18) + tabloB(cptBDD, 20) 'Exchange & Repair
                        End If
            Next

                    .Cells(j, 10) = som1 + som2 - som3 'quantities
        Next j

    End With

        With Sheets("Données").Range("I1:J" & Sheets("Données").Range("I" & Rows.Count).End(xlUp).Row)  ' Trie le tableau en fonction des valeurs des réparations
        'Tri le résultat du filtre en ordre croissant
        .Sort .Item(2, 2), xlAscending, , , , , , xlNo
        End With
        Call MiseAjour
    End Sub

Remplissage des tableaux sur les 3 feuilles

Private Sub MiseAjour()

    Dim tabloB, tabloF, tabloProv, tablor, dicoF As Object, dicoP As Object, cléF, cléP
    Dim i&, j&, f&, ln&, nom$, v

    tabloB = Sheets("BDD").Range("A2:AD" & Sheets("BDD").Range("A" & Rows.Count).End(xlUp).Row)
    tabloF = Sheets("Données").Range("E1:J" & Sheets("BDD").Range("E" & Rows.Count).End(xlUp).Row)
    Set dicoF = CreateObject("Scripting.Dictionary")
    Set dicoP = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False

    'Liste des familles et des pays
    For i = 1 To UBound(tabloF, 1)
        If tabloF(i, 5) <> "" Then dicoF(tabloF(i, 5)) = ""
        If tabloF(i, 1) <> "" Then dicoP(tabloF(i, 1)) = ""
    Next i

    For f = 1 To 3
    ' Création d'une Feuille
    Sheets.Add.Move After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "Feuil" & f
    ' Activation de la feuille
    Sheets("Feuil" & f).Activate

    'On reporte les titres sur le tableau des résultats
    Range("D1").Resize(1, dicoF.Count) = dicoF.keys
    Range("A2").Resize(dicoP.Count, 1) = Application.Transpose(dicoP.keys)
    Range("C1") = "Total"

    'On classe les pays et on les distribue sur le tableau des résultats
    tabloProv = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents
    For i = 1 To UBound(tabloProv, 1)
        Range("A" & 4 * i - 2) = tabloProv(i, 1)
        Range("B" & 4 * i - 2) = "Quantité"
        Range("B" & 4 * i - 1) = "Ventes"
        Range("B" & 4 * i) = "Réparation"
        Range("B" & 4 * i + 1) = "% Ventes / Réparation"
        Rows(4 * i + 1 & ":" & 4 * i + 1).NumberFormat = "0.00%"
    Next i

    'On définit le tableau des résultats comme une variable
    tablor = Range(Cells(1, 1), Cells(4 * UBound(tabloProv, 1) + 1, dicoF.Count + 3))
    Range(Cells(1, 1), Cells(4 * UBound(tabloProv, 1) + 1, dicoF.Count + 3)).Select

    'On reporte les données dans la variable tableau résultat
    For i = 1 To UBound(tabloB, 1)

        'Condition de recherche
        If tabloB(i, 1) = Sheets("Données").Cells(3 + f, 2).Value Then

        'On recherche la ligne dans le tableau résultat
        For j = 4 To UBound(tablor, 2)
            If tabloB(i, 24) = tablor(1, j) Then
                Exit For
            End If
        Next j
        'On recherche la ligne dans le tableau résultat
        For ln = 2 To UBound(tablor, 1) - 4
            If tabloB(i, 30) = tablor(ln, 1) Then
                Exit For
            End If
        Next ln

        'Cells(ln, j).Select

        tablor(ln, 3) = tablor(ln, 3) + tabloB(i, 11)                            'Qté
        tablor(ln, j) = tablor(ln, j) + tabloB(i, 11)

        tablor(ln + 1, 3) = tablor(ln + 1, 3) + tabloB(i, 12)                    'Ventes
        tablor(ln + 1, j) = tablor(ln + 1, j) + tabloB(i, 12)

        tablor(ln + 2, 3) = (tablor(ln + 2, 3) + tabloB(i, 14) + tabloB(i, 15) _
                + tabloB(i, 16) + tabloB(i, 18) + tabloB(i, 20)) * -1                 'Réparation
        tablor(ln + 2, j) = (tablor(ln + 2, j) + tabloB(i, 14) + tabloB(i, 15) _
                + tabloB(i, 16) + tabloB(i, 18) + tabloB(i, 20)) * -1

        On Error Resume Next
        tablor(ln + 3, 3) = tablor(ln + 2, 3) / tablor(ln + 1, 3)                   '%Réparation / Ventes
        tablor(ln + 3, j) = tablor(ln + 2, j) / tablor(ln + 1, j)
        On Error GoTo 0
' Range("A1").Resize(UBound(tablor, 1), UBound(tablor, 2)) = tablor
    End If
    Next i

    Range("A1").Resize(UBound(tablor, 1), UBound(tablor, 2)) = tablor
    Range("A1").Select

    Next f

End Sub

Est ce que tu pourrais me guider afin de finaliser cette étape de calcul ?

Merci

Bonjour

J'ai finalement réussi à le faire d'un coup.

Nouvelle version.

Bye !

Bonjour gmb,

Je ne vois pas la pièce jointe.

Je ne vois pas la pièce jointe.

Flute !

La voilà :

Bye !

16test-v2.xlsm (298.85 Ko)

Super merci à toi , ça fonctionne nickel et dire ma 1er macro durait 2 minutes . je n'ai plus qu'a adapter ma période afin de parler "01/10/2017" car actuellement mes périodes sont sous cette forme "AAA BBB 010.2017".

Encore un grand merci à toi pour ton aide

Rechercher des sujets similaires à "calcul tableau vba"