Microsoft 365 VBA Passer à la suite si supérieur

[akira21]

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 !!!

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]

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]

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]

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]

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

 

[akira21]

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]

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

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]

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

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.

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

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]

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

 

[akira21]

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]

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

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

 

[Dranreb]

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]

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]

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 :

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

 

[akira21]

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 :

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 🙂