Microsoft 365 VBA Passer à la suite si supérieur

akira21

XLDnaute Junior
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
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
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

XLDnaute Junior
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é ?
 

akira21

XLDnaute Junior
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 :

Capture1.JPG
 

Dranreb

XLDnaute Barbatruc
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)
 
Dernière édition:

akira21

XLDnaute Junior
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
 

akira21

XLDnaute Junior
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

XLDnaute Junior
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

XLDnaute Barbatruc
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

XLDnaute Junior
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 :confused:
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 :)
 

Discussions similaires

Réponses
4
Affichages
302

Membres actuellement en ligne

Statistiques des forums

Discussions
293 048
Messages
1 928 125
Membres
183 855
dernier inscrit
safelhr