Remplacement formules par un code VBA
bonjour le forum,
bonjour à tous;
je sollicite votre expertise pour améliorer ce fichier que j'utilise depuis 2 ans mais qui s'alourdit de mois en mois et devient très lent vers juillet-août-septembre jusqu'à la fin de l'année.
évidemment, je mets ici un exemple très allégé.
l'objectif c'est d'arriver à avoir un code VBA qui remplace les formules de C3 à BD220.
A - en colonne C et ainsi de suite vers le bas = exemple : C3 = SOMME E3:BD3
B - en colonne E et ainsi de suite jusqu'en colonne BD
Ba - les lignes impairs = exemple : en fonction du code en B3, on cherche les lignes ou on a le même code sur la feuille "SORTIES" en
colonne H et on somme les quantités en colonne J par sorte (P ou C)
--> 1/ somme de tous les 'P' multiplié par le chiffre en colonne D de la feuille "DONNEES" sur la ligne qui correspond au code.
--> 2/ somme de tous les 'C' multiplié par le chiffre en colonne H de la feuille "DONNEES" sur la ligne qui correspond au code.
--> 3/ SOMME des 2 Resultats.
Bb - les lignes pairs = exemple : en fonction du code en B3, on cherche les lignes ou on a le même code sur la feuille "ENTREES" en
colonne I et on somme les quantités en colonne F.
merci d'avance pour votre intérêt.
cordialement.
Moutchec.
Salut moutchec,
quelque chose comme ça?
Pour initialiser 'MVTS' avec les valeurs VBA :
- intégrer dans UNE COPIE de ton fichier de travail (teste d'abord !) les macros de chaque feuille ;
- effacer les formules en [E:BD] excepté les formules Totaux en fin de tableau.
- les Sub Worksheet_SelectionChange sont "sous commentaire" donc inopérantes en l'état : elles servent, via un simple clic sur chacune de ces deux feuilles à recalculer tes sommes selon les critères énoncés... sauf erreur de ma part, bien sûr!
Le traitement prend quelques (nombreuses) secondes. Ensuite, SUPPRIMER ces macros sinon, à chaque clic, le calcul reprendra de plus belle!
Le calcul ne s'effectue que sur les lignes pour lesquelles la macro trouve une correspondance entre les n° de code produit.
Ci-dessous, le calcul en SORTIES.
If Not Intersect(Target, Range("J:J")) Is Nothing And Cells(iRow, 1) > 0 And Cells(iRow, 8) > 0 Then
iRow1 = Range("A:A").Find(what:=Cells(iRow, 1), lookat:=xlWhole, searchdirection:=xlNext).Row
iRow2 = Range("A:A").Find(what:=Cells(iRow, 1), lookat:=xlWhole, searchdirection:=xlPrevious).Row
sWk1.Cells(sWk1.Range("B:B").Find(what:=Cells(iRow, 8), lookat:=xlWhole).Row, 4 + Cells(iRow, 1)) = _
WorksheetFunction.SumIfs(Range("J" & iRow1 & ":J" & iRow2), Range("H" & iRow1 & ":H" & iRow2), Cells(iRow, 8), Range("K" & iRow1 & ":K" & iRow2), "P") * _
sWk2.Range("A:A").Find(what:=Cells(iRow, 8), lookat:=xlWhole).Offset(0, 3) + _
WorksheetFunction.SumIfs(Range("J" & iRow1 & ":J" & iRow2), Range("H" & iRow1 & ":H" & iRow2), Cells(iRow, 8), Range("K" & iRow1 & ":K" & iRow2), "C") * _
sWk2.Range("A:A").Find(what:=Cells(iRow, 8), lookat:=xlWhole).Offset(0, 7)
sWk2.Range("E:BD").AutoFitA+
Bonjour, Bonjour curulis57
1-
je pense que, déjà, si tu enlevais les INDIRECT, car après tout les onglets ne sont pas vraiment des variables, ils ne sont que 2 (ENTREES et SORTIES)
cela permettrait de rester en excel sans macro
2-
autre méthode : tu as XL2016, pense à Power Query
3-
dernière solution ... un petit coup de TCD, voire 2, un entrées et un sorties et faire appel aux valeurs par LIREDONNEESTABCROISDYNAMIQUE
RE,
je ne m'y connais pas trop en macro mais je vois que c'est très compliqué à faire.
les résultats ne sont pas bons et ça prend plus de temps de calcul qu'avec formule, la question de la rapidité est la motivation première de l'idée VBA.
merci beaucoup pour votre intervention.
sincères salutations.
Moutchec.
Salut moutchec,
Pas d'accord!
J'ai mis ton 1er fichier à côté du mien, libéré des formules.
Qu'il puisse y avoir des erreurs, sans doute, ce serait trop beau, mais je constate que :
- les valeurs en SORTIES sont pratiquement toutes équivalentes (je n'ai pas regardé toutes les lignes, non plus!) ;
- que tes formules mettent un temps fou à se calculer là où VBA est instantané!
- que tes formules 'ENTREES'... ne se calculent pas!?
Là, je ne comprends pas!
A toi à essayer encore de trouver où le bât blesse!
Je continue ce soir à chercher ce qui pourrait clocher!
A+
RE,
voici le fichier avec les résultats attendus pour les semaines 1 à 5. en fait je pense avoir oublié de mentionner que les calculs doivent se faire par semaine, la colonne E correspondant à la semaine 1 et la colonne BD à la semaine 52.
les numéros de semaines sont en colonne A des feuilles ENTREES et SORTIES.
merci bcp pour votre intérêt.
Moutchec.
Bonjour Bonjour, Bonjour curulis57
Je ne partage pas vraiment le fait de calculer par macro
La macro peut automatiser certaines tâches comme actualiser des TCD
Je verrai donc plutôt une forme comme celle-ci (mais désolé, je me suis perdu dans les formules -bravo à vous deux, je n'ai pas eu le courage !- surtout que je retrouve pas du tout les valeurs), à partir de 2 TCD à réactualiser dans lesquels on va puiser les infos !
D'abord, la macro se contentera si nécessaire d'actualiser les TCD.
Ensuite, les calculs sont pris en charge par le TCD et n'alourdissent en rien le fichier. Si c'est cela l'objectif, il est alors atteint.
Salut moutchec,
pige plus trop ton calcul...
Beaucoup sont corrects tant en sortie qu'en entrée et d'autres...
A toi de vérifier certaines choses dans ton propre fichier... que je te renvoie, les feuilles SORTIES et ENTREES étant triées pour plus de facilité lors des tests.
J'ai recopié les colonnes de quantités sur le côté, histoire de retrouver les valeurs d'origine pour tests.
Prenons le produit 221410
- SORTIES semaine 3
10 pc. X 780 (P) = 7800
45 pc. X 65 (C) = 2925
Total = 11505 là où tu attends 8340
- ENTREES semaine 1
16175 là tu attends 8407
A te lire.
A+
bonjour le forum,
bonjour @Steelson,
bonjour @Curulis57,
je suis le premier étonné de constater ce matin que certains de mes résultats sont mauvais depuis 2 ans!!! vous avez en effet raison, sans doute imprécision au niveau des formules.
je me suis aussi gouré sur la colonne pour les "C" (colonne K) de la feuille SORTIES, il faut multiplier par colonne G de la feuille DONNEES et non "H".
Par contre, j'ai un BUG sur cette ligne du code de la feuille ENTREES :
Range("A2:I5267").Sort key1:=Range("A2"), order1:=xlAscending, key2:=Range("I2"), order2:=xlAscending, Orientation:=xlTopToBottom
pas de souci sur votre exemple, mais dans mon fichier toutes les colonnes de A à M sont remplies (non vides) et je pense que le problème vient de là.
merci bcp.
cordialement.
Moutchec.
Salut moutchec,
la ligne de code à problème dont tu parles n'existera pas dans ton fichier final : elle n'est là que pour faciliter les tests!
Je corrige en ce qui concerne le swap entre 'DONNEES' [G:H].
les résultats ne sont pas bons et ça prend plus de temps de calcul
J'ai droit à quel pourcentage pour la correction de tes chiffres d'entreprise?
Donc, c'est bon et on peut lancer la machine ?
A+
RE,
c'est ok.
comme quoi c'est toujours très bon d'avoir une autre approche des choses, de confronter....
Salut moutchec,
voilà le fichier avec les corrections demandées et améliorations diverses.
Suivre les instructions du post de hier, 18:22...
Petite nouveauté : dans la 'SORTIES' Sub Worksheet_SelectionChange(), après les lignes sous commentaire (voir instructions ci-dessus), se trouve un code destiné à créer une liste de validation "_ , C , P" en 'SORTIES' [K:K], histoire de faciliter l'encodage des "C,P" sans quitter la souris des mains. Ne pas effacer, évidemment... sauf si ça ne t'intéresse pas!
If Not Intersect(Target, Range("K:K")) Is Nothing Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="_,C,P"
.IgnoreBlank = True
.InCellDropdown = True
End With
End IfLe caractère "_" représente le vide si tu veux éliminer le C ou P affiché.
A quoi sert le bouton rouge que tu as créé dans 'MVTS' ?
A+
RE,
le bouton rouge sert à exécuter ce code : (je m'exerce petit à petit en apprenant sur le forum)
For z = 2 To Sheets("DONNEES").Range("A" & Rows.Count).End(xlUp).Row
For y = 3 To Sheets("MVTS").Range("A" & Rows.Count).End(xlUp).Row
If CStr(Sheets("DONNEES").Range("A" & z)) = CStr(Sheets("MVTS").Range("B" & y)) Then
Sheets("MVTS").Range("A" & y) = Sheets("DONNEES").Range("B" & z)
End If
Next
Next
le résultat s'affiche en colonne A de la feuille MVTS = va chercher les désignations en solonne B de la feuille DONNEES selon correspondance des codes en colonnes A des feuilles MVTS et DONNEES.
je viens de tester et le résultat est Nickel, c'est vraiment du haut niveau.
je vous remercie très sincèrement.
Moutchec.
Salut moutchec,
le code de ton bouton!
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
With Worksheets("DONNEES")
For x = 3 To Range("B" & Rows.Count).End(xlUp).Row Step 2
For y = 2 To .Range("A" & Rows.Count).End(xlUp).Row
If Cells(x, 2) = .Cells(y, 1) Then
Cells(x, 1) = .Cells(y, 2)
Exit For
End If
Next
Next
End With
'
Application.EnableEvents = True
Application.ScreenUpdating = True
'Et n'oublie pas...
A+
RE, je crois que je ne finirai pas de vous remercier.
avant de clôturer, je vous soumets une idée que je viens d'avoir :
je me disais qu'il n'était pas utile pour les codes d'aller chercher toutes les semaines sur les feuilles ENTREES et SORTIES, donc à chaque fois de la ligne 1 à x.
alors je me demandais s'il n'était pas possible que je saisisse un chiffre en D2 de la feuille MVTS et que les codes commencent par la première ligne ou ce chiffre est représenté.
exemple si je saisis 4 en D2, alors sur la feuille ENTREES, le code de la feuille commence à la ligne 4766 et sur la feuille SORTIES le code de la feuille commence à la ligne 953.
ainsi seules les semaines 4 et 5 seraient mises à jour, j'imagine que le résultat s'afficherait plus rapidement.
si c'est possible, je pense qu'en semaine 30, ça éviterait de recalculer inutilement les premières semaines de l'année .
je sais que je demande bcp pour le coup!!! dsl.
merci d'avance.
Moutchec.
Avec les autres demandes, ma nuit est faite !
Salut moutchec,
voici les changements demandés!
Tu as maintenant 2 boutons :
- le rouge pour la MAJ des résultats par semaine (code ci-dessous).
Tu es invité à encoder les n° de semaine souhaités séparés par un "/".
Quelques vérifications empêchent d'encoder n'importe quoi.
- l'autre pour la MAJ des noms de produits.
Application.ScreenUpdating = False
'
sRep = Application.InputBox("Quelles semaines souhaitez-vous mettre à jour ?", "MAJ", "1/2/3")
If sRep = "Faux" Or sRep = "" Then Exit Sub
tSplit = Split(sRep, "/")
'
On Error Resume Next
For x = 0 To UBound(tSplit)
If IsNumeric(tSplit(x)) Then
If CInt(tSplit(x)) >= 1 And CInt(tSplit(x)) <= Cells(2, Cells(2, Columns.Count).End(xlToLeft).Column) Then
For y = 1 To 2
lRow1 = 0
lRow2 = 0
With Worksheets(Choose(y, "ENTREES", "SORTIES"))
lRow1 = .Range("A:A").Find(what:=tSplit(x), lookat:=xlWhole, searchdirection:=xlNext).Row
lRow2 = .Range("A:A").Find(what:=tSplit(x), lookat:=xlWhole, searchdirection:=xlPrevious).Row
If lRow1 > 0 And lRow2 > 0 Then
If y = 1 Then
iRowA = Range("A" & Rows.Count).End(xlUp).Row
Cells(3, 4 + CInt(tSplit(x))).Resize(iRowA - 2) = ""
End If
For Z = lRow1 To lRow2
.Cells(Z, Choose(y, 6, 10)) = .Cells(Z, Choose(y, 6, 10)) + 0
Next
Else
MsgBox "Les données de la semaine " & tSplit(x) & " en '" & Choose(y, "ENTREES", "SORTIES") & " sont introuvables!", vbInformation + vbOKOnly, "MAJ - Info"
End If
End With
Next
End If
End If
Next
On Error GoTo 0
'
Application.ScreenUpdating = TrueA tester maintenant en situation réelle!
A+
bonjour @Curulis57,
c'est incroyable ce que vous avez fait, soyez-en remerciééééééééééééé.
c'est au delà de tout ce que je pouvais espérer quand j'ai pensé à explorer la piste VBA, c'est tout simplement génial, parfait et GENTIL.
merci à vous et aux promoteurs de ce site.
bien à vous.
Moutchec.
Bonjour @curulis57
je reviens encore vous remercier pour votre travail sur ce fichier, j'ai testé dans tous les sens hier en remontant jusqu'en 2017, c'est très réussi. merci.
Moutchec.
Salut Moutchec,
très heureux de ce retour et d'apprendre que tout baigne!
Et merci à toi pour cette appréciation de mon travail très agréable à lire!
Bon travail!
A+