Microsoft 365 VBA Passer à la suite si supérieur

akira21 · 24 Août 2021

Bonjour,

Je sollicite votre aide sur un complément à ajouter à la macro ci-dessous.

J'ai besoin qu'à partir du moment où la somme des chargements est supérieur au déploiement fait ( colonne G ) alors la suite des chargements passe à la suite.

Pour mieux expliquer les choses, j'ai joint un fichier qui je l'espère sera plus explicite que mes explications !!!

VB:

Sub Chgt()
    Application.ScreenUpdating = False
    Range("K5:FF1500").Select
    Selection.ClearContents
  
    Dim Première_Ligne As Integer, Dernière_Ligne As Integer, i As Integer, Compteur As Byte, Couleur As Boolean
      
 
  
    Range("A5").Activate
  
Retour:
    Compteur = 5
  
    Première_Ligne = ActiveCell.Row
  
    Do Until ActiveCell.Offset(1, 0) <> ActiveCell
        If ActiveCell = "" Then Exit Sub
        ActiveCell.Offset(1, 0).Activate
    Loop
  
    Dernière_Ligne = ActiveCell.Row
  
              
      With Sheets("Tampon")
            For i = 5 To .Range("A" & Rows.Count).End(xlUp).Row
                If .Range("D" & i) = Range("A" & Première_Ligne) Then
                    Compteur = Compteur + 6
                    Cells(Première_Ligne, Compteur) = .Range("B" & i)
                    Cells(Première_Ligne, Compteur + 1) = .Range("C" & i)
                    Cells(Première_Ligne, Compteur + 2) = .Range("F" & i)
                    Cells(Première_Ligne, Compteur + 3) = .Range("G" & i)
                    Cells(Première_Ligne, Compteur + 4) = .Range("J" & i)
                    Cells(Première_Ligne, Compteur + 5) = .Range("K" & i)
                End If
            Next i
        End With
          
  
    ActiveCell.Offset(1, 0).Activate
  
    GoTo Retour

End Sub

Fichier trop volumineux alors voici le lien de partage

Fichier

Dranreb · 24 Août 2021

Bonjour.
Ma première impression est qu'il vaudrait mieux explorer la source la plus détaillée et chercher où la mettre dans l'autre plutôt que l'inverse.
Mais je cherche simplement à comprendre pour le moment, et ce n'est pas évident.
À supposer que le tableau en "Test" était complètement regarni par macro à partir d'une source interne, faudrait-il en reprendre des informations pour la constituer, ou bien les infos de la feuille "Tampon" suffiraient ?

akira21 · 24 Août 2021

Dranreb à dit:
Bonjour.
Ma première impression est qu'il vaudrait mieux explorer la source la plus détaillée et chercher où la mettre dans l'autre plutôt que l'inverse.
Mais je cherche simplement à comprendre pour le moment, et ce n'est pas évident.
À supposer que le tableau en "Test" était complètement regarni par macro à partir d'une source interne, faudrait-il en reprendre des informations pour la constituer, ou bien les infos de la feuille "Tampon" suffiraient ?

Bonjour Dranreb et merci de t'intéresser à mon problème

Que veux tu dire par reprendre les infos ?
En fait il me faut exactement les infos qui sont sur le fichier.

A partir de la colonne K, je reprends les infos de la feuille Tampon.
De A:E, je reprends les infos d'un planning que j'ai en Query, que je n'ai pas intégré dans le fichier test.

J'espère t'avoir aidé ?

Dranreb · 24 Août 2021

Non, je ne sait pas faire comme vous demandez.
Il faut mettre en correspondance dans un tableau interne les infos à garder des deux sources et les ressortir ensuite dans l'ordre souhaité.

Dranreb · 24 Août 2021

Je sais faire comme ça, avec un regroupement interne sur le CodeSAP.

akira21 · 24 Août 2021

Dranreb à dit:
Je sais faire comme ça, avec un regroupement interne sur le CodeSAP.

Bonjour Dranreb,

Merci de consacrer du temps à mon problème
J'ai un petit problème avec ton fichier.
Quand j'actualise, cela me renvoie l'erreur ci-dessous et rien ne se passe :

Dranreb · 24 Août 2021

Aïe. Pourriez vous dans le module MGigogne ajouter une Instruction JusteLesNumérosDeLignes = False à la fin de la fonction Gigogne ?

VB:

Function Gigogne(ByVal PlageOuTableau, ParamArray ColOrd() As Variant) As Collection
   TableauAcquis TDon, PlageOuTableau, Pour:="Gigogne"
   If UBound(ColOrd) >= LBound(ColOrd) Then InterpréterParam ColOrd, UBound(TDon, 2), Pour:="Gigogne"
   IndexerParFusions TbIdx, TDon
   ReDim ValArg(1 To RupMax): Posit = 1: Ligne = TbIdx(1): Set Gigogne = SousGroupes(1)
   ArgMax = 0: RupMax = &H7FFFFFFF: Tronquer = False: Préfiltré = False: JusteLesNumérosDeLignes = False
   Erase TDon, TCols, TSens, TbIdx, ValArg, TLgnFlt
   End Function

C'est une disposition très peu utilisée, mise en place par une invocaton de la Sub GarderOrdreInitial et … oublié de l'annuler tout à la fin.
Je corrige de mon coté aussi, bien entendu.
Édition et du coup, dans la procédure principale le MGigogne.GarderOrdreInitial TDon, RngTest
doit être déplacé plus bas, juste avant le For Each CodeSap In Gigogne(WshTest.[A5:F5], 1)

akira21 · 24 Août 2021

Dranreb à dit:
Aïe. Pourriez vous dans le module MGigogne ajouter une Instruction JusteLesNumérosDeLignes = False à la fin de la fonction Gigogne ?

VB:

Function Gigogne(ByVal PlageOuTableau, ParamArray ColOrd() As Variant) As Collection TableauAcquis TDon, PlageOuTableau, Pour:="Gigogne" If UBound(ColOrd) >= LBound(ColOrd) Then InterpréterParam ColOrd, UBound(TDon, 2), Pour:="Gigogne" IndexerParFusions TbIdx, TDon ReDim ValArg(1 To RupMax): Posit = 1: Ligne = TbIdx(1): Set Gigogne = SousGroupes(1) ArgMax = 0: RupMax = &H7FFFFFFF: Tronquer = False: Préfiltré = False: JusteLesNumérosDeLignes = False Erase TDon, TCols, TSens, TbIdx, ValArg, TLgnFlt End Function

C'est une disposition très peu utilisée, mise en place par une invocaton de la Sub GarderOrdreInitial et … oublié de l'annuler tout à la fin.
Je corrige de mon coté aussi, bien entendu.
Édition et du coup, dans la procédure principale le MGigogne.GarderOrdreInitial TDon, RngTest
doit être déplacé plus bas, juste avant le For Each CodeSap In Gigogne(WshTest.[A5:F5], 1)

Merci pour le retour

Je pense avoir fait comme demandé. Je n'ai plus l'erreur mais aucune actualisation se fait.

VB:

Function Gigogne(ByVal PlageOuTableau, ParamArray ColOrd() As Variant) As Collection
   TableauAcquis TDon, PlageOuTableau, Pour:="Gigogne"
   If UBound(ColOrd) >= LBound(ColOrd) Then InterpréterParam ColOrd, UBound(TDon, 2), Pour:="Gigogne"
   IndexerParFusions TbIdx, TDon
   ReDim ValArg(1 To RupMax): Posit = 1: Ligne = TbIdx(1): Set Gigogne = SousGroupes(1)
   ArgMax = 0: RupMax = &H7FFFFFFF: Tronquer = False: Préfiltré = False: JusteLesNumérosDeLignes = False
   Erase TDon, TCols, TSens, TbIdx, ValArg, TLgnFlt
   End Function

Code:

Sub Chgt()
   Dim TbInt(), DicTamp As Dictionary, RngTest As Range, Cln As Collection, TDon(), CodeSap As SsGr, TTamp(), LTmp As Long, Détail, LDét As Long, TRés(), C As Integer
   Set DicTamp = MGigogne.DicoGig(Gigogne(WshTamp.[A7:J7], 4))
   Set RngTest = ColUti(WshTest.[A5:F5], True)
   Set Cln = Gigogne(WshTest.[A5:F5], 1)
   ReDim TRés(1 To RngTest.Rows.Count, 1 To 9)
   MGigogne.GarderOrdreInitial TDon, RngTest
   For Each CodeSap In Gigogne(WshTest.[A5:F5], 1)
      If DicTamp.Exists(CodeSap.Id) Then
         TTamp = DicTamp(CodeSap.Id): LTmp = 1
         For Each Détail In CodeSap.Co
            LDét = Détail: C = 2
            Do While LTmp <= UBound(TTamp, 1)
               If TRés(LDét, 1) + TTamp(LTmp, 7) > TDon(LDét, 6) Then Exit Do
               TRés(LDét, 1) = TRés(LDét, 1) + TTamp(LTmp, 7)
               TRés(LDét, 2) = TDon(LDét, 6) - TRés(LDét, 1)
               If UBound(TRés, 2) < C + 5 Then ReDim Preserve TRés(1 To UBound(TRés, 1), 1 To C + 5)
               TRés(LDét, C + 1) = TTamp(LTmp, 2)
               TRés(LDét, C + 2) = TTamp(LTmp, 3)
               TRés(LDét, C + 3) = TTamp(LTmp, 6)
               TRés(LDét, C + 4) = TTamp(LTmp, 7)
               TRés(LDét, C + 5) = TTamp(LTmp, 10)
               C = C + 6: LTmp = LTmp + 1: Loop
            Next Détail
         End If
      Next CodeSap
   WshTest.[G5].Resize(1000000, 10000).ClearContents
   WshTest.[G5].Resize(UBound(TRés, 1), UBound(TRés, 2)).Value = TRés
End Sub

Dranreb · 24 Août 2021

Chez moi elle se fait. Peut être était-il en mode arrêt ?
Je le re-joins à tout hasard.

akira21 · 24 Août 2021

Pardon, au temps pour moi. J'avais supprimé la partie actualisée pour faire le test mais comme un idiot j'avais aussi supprimé la colonne total prod
Cela fonctionne très bien
Je vais faire des tests en profondeur.

Je viens d'en faire un sur la ligne 31.
Si on passe le total prod à 9, le chargement ne s'affiche plus car le total prod est inférieur au nombre prévu dans le chargement.
Hors il se peut qu'un chargement soit prévu avec un nombre supérieur à la quantité de la production.
Avez vous une solution pour ça ?

En tout cas, encore un grand merci pour votre aide

akira21 · 24 Août 2021

Je viens de remarquer que dans la colonne H, les + / - sont inversés.

Le résultat devrait donner -4 et non +4

Dranreb · 24 Août 2021

Dans la Sub Chgt() mettez
TRés(LDét, 2) = TRés(LDét, 1) - TDon(LDét, 6) au lieu de
TRés(LDét, 2) = TDon(LDét, 6) - TRés(LDét, 1)

akira21 · 24 Août 2021

Dranreb à dit:
Dans la Sub Chgt() mettez
TRés(LDét, 2) = TRés(LDét, 1) - TDon(LDét, 6) au lieu de
TRés(LDét, 2) = TDon(LDét, 6) - TRés(LDét, 1)

Merci c'est bon

Avez vous une solution pour le problème dit plus haut ?

Je viens d'en faire un sur la ligne 31.
Si on passe le total prod à 9, le chargement ne s'affiche plus car le total prod est inférieur au nombre prévu dans le chargement.
Hors il se peut qu'un chargement soit prévu avec un nombre supérieur à la quantité de la production.
Avez vous une solution pour ça ?

Dranreb · 24 Août 2021

Il semblerait que ce que vous voudriez dans ce cas de figure aille complètement à l'encontre de ce que vous demandiez d'abord.
À moins de prévoir un seuil arbitraire de dépassement autorisant à mettre encore sur la même ligne :

VB:

If TRés(LDét, 1) + TTamp(LTmp, 7) > TDon(LDét, 6) + 10 Then Exit Do

akira21 · 24 Août 2021

Dranreb à dit:
Il semblerait que ce que vous voudriez dans ce cas de figure aille complètement à l'encontre de ce que vous demandiez d'abord.
À moins de prévoir un seuil arbitraire de dépassement autorisant à mettre encore sur la même ligne :

VB:

If TRés(LDét, 1) + TTamp(LTmp, 7) > TDon(LDét, 6) + 10 Then Exit Do

Je comprends, c'est vrai que j'aurai du le préciser au début
Je vais voir à l'utilisation si cette solution de seuil est adapté.

Encore un grand merci pour votre aide, je n'y serais jamais arrivé sans vous

Microsoft 365 VBA Passer à la suite si supérieur

akira21

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

akira21

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Pièces jointes

akira21

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

akira21

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

Pièces jointes

akira21

XLDnaute Occasionnel

akira21

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

akira21

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

akira21

XLDnaute Occasionnel

Discussions similaires