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
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)
Voici en pièce jointe un fichier très fortement réduit pour l'exemple.
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.
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
Cela, ce n'était pas présisé au départ.Le calcul voulu est : Année 2016 + Octobre 2017 - Octobre 2016
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.
Flute !Je ne vois pas la pièce jointe.
La voilà :
Bye !
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