Passer à la suite si supérieur

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

Cela dépasse mes compétences alors merci d'avance pour aide :)

7classeur2.zip (164.12 Ko)

Bonjour akira,

Avant de me pencher sur la macro, je cherches à comprendre ton fichier:

- Les infos en colonne A:F de la feuil "Test" proviennent d'une extraction de SAP?

- A quoi servent les colonnes I:J ( masquées) ?

- Pourquoi dans la 1er ligne '151655' qui à un début et une fin au 24/08/2021, nous retrouvons une date '27/08/2021' sous le code CODCHG: T19-47 ?

Bonjour Florian,

Tout d'abord merci de t'intéresser à mon problème :)

Ci-dessous les réponses à tes question !

- Les infos en colonne A:F de la feuil "Test" proviennent d'une extraction de SAP?

Non, elles proviennent d'un power query excel ( planning production )

- A quoi servent les colonnes I:J ( masquées) ?

A rien ! Je n'avais pas vu que des données s'y étaient insérées ! Elles sont inutiles et ont dû se mettre lors de mes tests :/

- Pourquoi dans la 1er ligne '151655' qui à un début et une fin au 24/08/2021, nous retrouvons une date '27/08/2021' sous le code CODCHG: T19-47 ?

Les dates en colonnes C et D sont les dates de production et les dates, exemple sous le code T19-47 sont les dates prévues de chargement de camion suite à ses productions.

En réalité, dans l'exemple du 1er ensemble de 151655, il y a 6 batch de prod soit un total de 148 palettes à expédier.

Le déploiement fait, c'est à dire le nombre palette prévue à expédier est de 178 palettes ( colonne G )

Donc il devrait avoir dans la zone chargement ( à partir de la colonne K ) autant de camion pour 148 palettes et au dela passer la suite des camions à la ligne 16, c'est à dire la 2eme production de 151655.

J'espère avoir pu t'aider !

En réfléchissant, la formule de la colonne G risque de poser problème car elle ne soustrait pas le déploiement fait au dessus si même code SAP ?

Voici un essai en pièce jointe:

5classeur2-akira.zip (143.85 Ko)

Wow, tu as tout refait de A à Z :)

J'ai fait qqes test et cela m'a l'air plus que parfait !

J'ai juste un problème, surement lors de la suppression de données, cela supprime le format des cellules ainsi que leur taille :/

Edit: Mauvaise Manip

Avec une mise au format.

Désolé d'être embêtant mais j'ai le même résultat

Les colonnes d'heure s'élargissent et le format heure s'enlève.

Les colonnes vides comme la colonne P redevient large et impossible de laisser une largeur à 1. Dès que j'actualise tout redevient par défaut

Et certaines fois, si j'actualise plusieurs fois à la suite, le format des cellules changent aléatoirement

Voici une mise à jour avec une V3

Désolé je n'ai pu répondre avant

Un grand merci Florian pour aide, c'est tout simplement parfait.

Je n'aurai jamais su faire ça tout seul et cela me permet d'apprendre en même temps

Je te souhaite une agréable fin de journée

Edit : Je viens de m'apercevoir qui si la quantité "Total Prod" est en dessus de la quantité d'un seul chargement, cela me renvoi à cette erreur

   If UBound(New_tab, 2) > dercol Then 

Hors il se peut que cela arrive.

Exemple, si je passe le 1er 10 ( total prod ) à 9 et qu'il n'y a pas d'autre chargement, juste celui là qui est prévu en trop grosse quantité

capture

Bonjour akira,

Voici une modification du code:

Sub Extraction()
    Dim Ws_BDD     As Worksheet
    Dim Ws_result  As Worksheet
    Dim derlgn     As Long
    Dim Tab_Code_SAP()
    Dim Tab_BDD    As Variant
    Dim i          As Long
    Dim som        As Double
    Dim New_tab()
    Dim x          As Integer

    Application.ScreenUpdating = False

    'Affectation des Objets
    Set Ws_BDD = Sheets("Tampon")
    Set Ws_result = Sheets("Test")
    Set Dico_Works = CreateObject("Scripting.Dictionary")
    dercol = 5

    'Purge des anciennes Données & Alimentation des nouvelles
    Tab_BDD = Ws_BDD.Range("A6").CurrentRegion

    With Ws_result
        derlgn = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range("K:BB").Delete
        .Range("G5:G" & derlgn).ClearContents
        Tab_Code_SAP = .Range("A5:F" & derlgn)
        Dico_Works = Dico(Tab_Code_SAP)
    End With

    For Each c In Dico_Works
        For i = 1 To UBound(Tab_Code_SAP, 1)
            x = 0
            If Tab_Code_SAP(i, 1) = c And Tab_Code_SAP(i, 6) > 0 Then
                For j = 2 To UBound(Tab_BDD, 1)
                    If Tab_BDD(j, 4) = c And som <= Tab_Code_SAP(i, 6) And Tab_BDD(j, 10) <> "passe" Then
                        If som + Tab_BDD(j, 7) <= Tab_Code_SAP(i, 6) Then
                            ReDim Preserve New_tab(0, 1 To 5 + (5 * x))
                            New_tab(0, 1 + (5 * x)) = Tab_BDD(j, 2) ' DATCODCHG
                            New_tab(0, 2 + (5 * x)) = Tab_BDD(j, 3) ' HEUPRECHG
                            New_tab(0, 3 + (5 * x)) = Tab_BDD(j, 6) ' CODCHG
                            New_tab(0, 4 + (5 * x)) = Tab_BDD(j, 7) ' NBRPAL2
                            New_tab(0, 5 + (5 * x)) = Tab_BDD(j, 10)
                            Tab_BDD(j, 10) = "passe"
                            som = som + Tab_BDD(j, 7) ' Cumul
                            x = x + 1
                        Else
                            With Ws_result
                                On Error Resume Next
                                If UBound(New_tab, 2) > dercol Then dercol = UBound(New_tab, 2)
                                .Range("K" & 4 + i).Resize(UBound(New_tab, 1) + 1, UBound(New_tab, 2)) = New_tab
                                .Range("K" & 4 + i).Resize(UBound(New_tab, 1) + 1, UBound(New_tab, 2)).Borders.LineStyle = 1
                                .Range("G" & 4 + i) = som
                                Erase New_tab
                                On Error GoTo 0
                                som = 0: GoTo svt
                            End With
                        End If
                    End If
                Next j
                With Ws_result
                    On Error Resume Next
                    If UBound(New_tab, 2) > dercol Then dercol = UBound(New_tab, 2)
                    .Range("K" & 4 + i).Resize(UBound(New_tab, 1) + 1, UBound(New_tab, 2)) = New_tab
                    .Range("K" & 4 + i).Resize(UBound(New_tab, 1) + 1, UBound(New_tab, 2)).Borders.LineStyle = 1
                    On Error GoTo 0
                    .Range("G" & 4 + i) = som
                    Erase New_tab
                    som = 0
                End With
            End If

svt:
        Next i
    Next c

    x = 0
    With Ws_result
        .Columns.AutoFit
        For i = 5 To dercol - 5 Step 5
            .Columns((i - 4) + 11 + x).NumberFormat = "hh:mm"
            .Cells(1, i + 11 + x).EntireColumn.Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
            x = x + 1
             .Columns(i + 10 + x).ColumnWidth = 1
        Next i
     End With

    With Ws_result.Range(Ws_result.Cells(4, 11), Ws_result.Cells(4, dercol + 10 + x))
            .MergeCells = True
            .Value = "Chargement"
            .Interior.Color = 15773696
            .Font.ColorIndex = 2
            .Font.Size = 12
            .Font.Bold = True
    End With

    Set Ws_BDD = Nothing: Set Ws_result = Nothing: Set Dico_Works = Nothing

    Application.ScreenUpdating = True

End Sub

Bonjour Florian,

Désolé, je n'ai pu me connecter avant et donc te répondre

Merci bcp d'avoir passer du temps à mon problème, tout est fonctionnel

Je te souhaites une agréable journée

Rechercher des sujets similaires à "passer suite superieur"