XL 2013 Optimiser via VBA

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

don julio

XLDnaute Nouveau
Bonjour

J'ai besoin de votre aide sur VBA ...

Je souhaites regrouper des palette afin d'optimiser mon espace de stockage via une macro.

Je m'explique : j'ai plusieurs places occupés par la même référence dans mon espace de stockage, cependant j'ai parfois des moitiés de palette ( voir moins) et j'occupe donc deux places ( ou plus) alors que je pourrai les regrouper pour n'occuper qu'une seule place ...

Je souhaite donc savoir s'il y a un moyen de regarder pour chaque référence et optimiser le stockage.

Pour etre plus clair merci de trouver un exemple en PJ ...

Merci d'avance

Don Julio
 

Pièces jointes

Bonjour Pour qu'elle raison cette référence ne peux pas être sur le même emplacement :
A1 ; A ; 15; 35
A2 ; A ; 18 ; 35

Puisque 15 + 18 quantités sur l'emplacement est inférieur à 35 quantités sur une palette !

Sans les règles c'est impossible de faire le code

Laurent
 
Bon je suis un boulet , j'ai créer l'exemple a la va-vite et du coup il y avait des "coquilles"( merci a Laurent de me les signaler), du coup je vous remet un exemple qui normalement ne devrait pas contenir d'erreur ...
Bonsoir Don Julio,

Voici ton fichier en retour. Affiche cases à transérer en M et quantité en N

@+
 

Pièces jointes

Bonjour Arpette,

Merci beaucoup pour le retour du fichier, cependant il n'est pas a 100 % fonctionel, dans l'exemple je souhaite qu'il m'indique que je peux regrouper 2 palettes de la référence F, ainsi que 2 fois 2 palettes de la référence I ..

merci bien

Bonne fin de journée
Don Julio
 
Bonjour Don Julio,

Oui je l'avais vu, mon problème est que j'additionne les quantités de toutes les référeces et les compare à la quantité par palette. Donc pour F = 36 pour une quantité par palette de 20 donc je regroupe pas alors que je pourrais regrouper A11 et A13.
Je regarde comment je peux faire.

@+
 
Bonsoir
Peut être cette solution :

VB:
Option Base 1
Sub RepartitionPalette()

' suppression
Range(Cells(2, 14), Cells(Cells(65536, 1).End(xlUp).Row, 14)).ClearContents

Dim TabBd As Variant
TabBd = Range(Cells(2, 1), Cells(Cells(65536, 1).End(xlUp).Row, 4))
ReDim Preserve TabBd(LBound(TabBd, 1) To UBound(TabBd, 1), LBound(TabBd, 2) To 5)

' Inventaire référence
For i = LBound(TabBd, 1) To UBound(TabBd, 1)
    For j = LBound(TabBd, 1) To UBound(TabBd, 1)
        If TabBd(i, 2) = TabBd(j, 2) Then
            TabBd(i, 5) = TabBd(i, 5) + TabBd(j, 3)
        End If
    Next j
Next i

' Tableau référence
ReDim Preserve TabBd(LBound(TabBd, 1) To UBound(TabBd, 1), LBound(TabBd, 2) To 6)

For i = LBound(TabBd, 1) To UBound(TabBd, 1)
    If TabBd(i, 4) = 0 Then
        Cells(i + 1, 14) = TabBd(i, 4)
    ElseIf TabBd(i, 5) > TabBd(i, 4) Then
        TabBd(i, 6) = TabBd(i, 5)
        TabBd(i, 5) = TabBd(i, 5) - TabBd(i, 4)
        Cells(i + 1, 14) = TabBd(i, 5)
        TabBd(i, 5) = TabBd(i, 6) - TabBd(i, 5)
            For j = i + LBound(TabBd, 1) To UBound(TabBd, 1)
                If TabBd(i, 2) = TabBd(j, 2) Then
                    TabBd(j, 5) = TabBd(i, 5)
                End If
            Next j
    ElseIf TabBd(i, 5) <= TabBd(i, 4) Then
        TabBd(i, 6) = TabBd(i, 5)
        Cells(i + 1, 14) = TabBd(i, 6)
            For j = i + LBound(TabBd, 1) To UBound(TabBd, 1)
                If TabBd(i, 2) = TabBd(j, 2) Then
                    TabBd(j, 5) = 0
                End If
            Next j
    End If
Next i
End Sub

Ps : Une erreur de quantité sur
- Qté sur emplacement pour référence F ( 12 + 16 + 16 = soit 44 qtés) différence avec la recap
dans le fichier excel Origine donc corrigé.

Le module a l'air de bien fonctionner, il peut être adaptable l'idée est là et le résultat attendu
correspond bien à la demande.

Laurent
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
12
Affichages
1 K
Réponses
2
Affichages
1 K
Réponses
4
Affichages
795
Retour