Calculer le nmbre d'assemlblage possible

Le 07/11/2019 à 10:31

Bonjour,

Je sollicite votre support pour trouver une solution a mon probleme.

Je souhaiterai calculer le nombre d'assemblage possible pour les articles parent en tenant en compte la quantité nécessaire et le stock disponible des articles composants (childe).

l'objectif est pouvoir introduire la référence de l'article parent et d'avoir le nombre d'assemblage possible directement.

En pj vous trouverez un fichier avec les données stock et bill of material.

Merci infinement en avance pour vos réponse.

Kmab

10nbre-assembly-possible.xlsx (28.14 Ko)
Le 07/11/2019 à 12:01

Bonjour,

une proposition (introduire la ref de la pièce en B3)

11nbre-assembly-possible.xlsm (38.36 Ko)
Le 07/11/2019 à 12:20

Bonjour H2so4,

Merci pour votre réponse.

Pourriez vous Svp m'envoiyé la macros utilisé puisque je n'arrive a l'excuter automatiquement (acceé bloqué par mon administrateur).

Merci en avance.

2019 11 07 12h17 03
Le 07/11/2019 à 13:09

bonjour,

voici les macros

1ere macro à ajouter dans un nouveau module

Option Explicit

Function nap(mat)
Dim wsb As Worksheet
Dim wss As Worksheet
Dim re As Range
Dim plageb As Range
Dim pile(1000, 2)
Dim dicts As Object
Dim dictp As Object
Dim dls&, dlb&, i&, npile&, maxpile&, m$, q&, mqp&, k&, cle, fa$, qp&

    Set wsb = Sheets("bill of material")
    Set wss = Sheets("stock")
    dlb = wsb.Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne de wsb
    Set plageb = wsb.Range("A1").Resize(dlb, 1) 'plage de ref de material
    dls = wss.Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne du stock
    Set dicts = CreateObject("scripting.dictionary") 'dictionnaire des pièces en stock cle=reference, item=quantité en stock
    Set dictp = CreateObject("scripting.dictionary") 'dictionnaire des pièces raw pour ce produit cle=référence raw, item=quantité nécessaire

    'chargement dictionnaire stock
    For i = 2 To dls
        dicts(wss.Cells(i, 1).Value) = wss.Cells(i, 3)
    Next i

    npile = 1 ' pointeur de reférence à traiter
    maxpile = 0 ' nombre max de références traitées
    pile(npile, 1) = mat '1 er élément à traiter est la référence du produit initial
    pile(npile, 2) = 0

    Do While npile > 0 'tant qu'il y a des références à traiter
        m = pile(npile, 1) ' référence
        q = pile(npile, 2) ' quantité nécessaire
        If npile > maxpile Then maxpile = npile
        npile = npile - 1 ' cet élément de la pile est traité

        ' recherche de la référence dans bill
        Set re = plageb.Find(m, lookat:=xlWhole, LookIn:=xlValues)

        If re Is Nothing Then 'référence non trouvée dans bill
            If maxpile = 1 Then nap = "pièce " & m & " non trouvée": Exit Function 'si première référence
            dictp(m) = dictp(m) + q 'sinon on ajoute la piece raw (et quantité) au dictionnaire des pièces nécessaires
        Else
        'sinon on traite toutes les lignes de bill avec cette référence
            fa = re.Address
            Do
                npile = npile + 1 'on ajoute les composants à la pile
                pile(npile, 1) = re.Offset(, 1) 'référence
                pile(npile, 2) = re.Offset(, 2) 'quantité
                Set re = plageb.FindNext(re)
            Loop Until re.Address = fa
        End If
        DoEvents
    Loop
    'le dictionnaire des pièces raw nécessaires et leur quantité pour une pièce finale est constitué
    'on vérifie combien de pièces finales on peut faire
        mqp = 100000
        k = 5
        For Each cle In dictp.keys
            k = k + 1
            Cells(k, 1) = cle
            Cells(k, 2) = dicts(cle)
            Cells(k, 3) = dictp(cle)
            qp = Int(dicts(cle) / dictp(cle))
            Cells(k, 4) = qp
            If qp < mqp Then mqp = qp
            Cells(k, 5) = mqp
        Next
        nap = mqp
End Function

2ème macro (événementielle) à ajouter dans le module de la feuille nbr assembly possible

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$B$3" Then
        Rows("6:1000").Clear
        Range("B4") = nap(Target.Value)
    End If
End Sub
19nbre-assembly-possible.xlsm (40.49 Ko)
Le 10/11/2019 à 13:49

Bonjour,

la version précédente contient un bug. voici une correction

version avec gestion de pile

Option Explicit

Function nap(mat)
Dim wsb As Worksheet
Dim wss As Worksheet
Dim re As Range
Dim plageb As Range
Dim pile(1000, 2)
Dim dicts As Object
Dim dictp As Object
Dim dls&, dlb&, i&, npile&, maxpile&, m$, q&, mqp&, k&, cle, fa$, qp&

    Set wsb = Sheets("bill of material")
    Set wss = Sheets("stock")
    dlb = wsb.Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne de wsb
    Set plageb = wsb.Range("A1").Resize(dlb, 1) 'plage de ref de material
    dls = wss.Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne du stock
    Set dicts = CreateObject("scripting.dictionary") 'dictionnaire des pièces en stock cle=reference, item=quantité en stock
    Set dictp = CreateObject("scripting.dictionary") 'dictionnaire des pièces raw pour ce produit cle=référence raw, item=quantité nécessaire

    'chargement dictionnaire stock
    For i = 2 To dls
        dicts(wss.Cells(i, 1).Value) = wss.Cells(i, 3)
    Next i

    npile = 1 ' pointeur de reférence à traiter
    maxpile = 0 ' nombre max de références traitées
    pile(npile, 1) = mat '1 er élément à traiter est la référence du produit initial
    pile(npile, 2) = 0

    Do While npile > 0 'tant qu'il y a des références à traiter
        m = pile(npile, 1) ' référence
        q = pile(npile, 2) ' quantité nécessaire
        If npile > maxpile Then maxpile = npile
        npile = npile - 1 ' cet élément de la pile est traité

        ' recherche de la référence dans bill
        Set re = plageb.Find(m, lookat:=xlWhole, LookIn:=xlValues)

        If re Is Nothing Then 'référence non trouvée dans bill
            If maxpile = 1 Then nap = "pièce " & m & " non trouvée": Exit Function 'si première référence
            dictp(m) = dictp(m) + q 'sinon on ajoute la piece raw (et quantité) au dictionnaire des pièces nécessaires
        Else
        'sinon on traite toutes les lignes de bill avec cette référence
            fa = re.Address
            Do
                npile = npile + 1 'on ajoute les composants à la pile
                pile(npile, 1) = re.Offset(, 1) 'référence
                pile(npile, 2) = re.Offset(, 2) * q 'quantité
                Set re = plageb.FindNext(re)
            Loop Until re.Address = fa
        End If
        DoEvents
    Loop
    'le dictionnaire des pièces raw nécessaires et leur quantité pour une pièce finale est constitué
    'on vérifie combien de pièces finales on peut faire
        mqp = 100000
        k = 5
        For Each cle In dictp.keys
            k = k + 1
            Cells(k, 1) = cle
            Cells(k, 2) = dicts(cle)
            Cells(k, 3) = dictp(cle)
            qp = Int(dicts(cle) / dictp(cle))
            Cells(k, 4) = qp
            If qp < mqp Then mqp = qp
            Cells(k, 5) = mqp
        Next
        nap = mqp
End Function

version avec procédure récursive

Option Explicit
Dim dict_stock As Object
Dim dict_pieces As Object
Function nap(mat)
    Dim wsb As Worksheet
    Dim wss As Worksheet
    Dim re As Range
    Dim plageb As Range

    Dim dls&, dlb&, i&, m$, q&, mqp&, k&, cle, fa$, qp&, niveau&

    Set wsb = Sheets("bill of material")
    Set wss = Sheets("stock")
    dlb = wsb.Cells(Rows.Count, 1).End(xlUp).Row    'dernière ligne de wsb
    Set plageb = wsb.Range("A1").Resize(dlb, 1)    'plage de ref de material
    dls = wss.Cells(Rows.Count, 1).End(xlUp).Row    'dernière ligne du stock
    Set dict_stock = CreateObject("scripting.dictionary")    'dictionnaire des pièces en stock cle=reference, item=quantité en stock
    Set dict_pieces = CreateObject("scripting.dictionary")    'dictionnaire des pièces raw pour ce produit cle=référence raw, item=quantité nécessaire

    ' si la pièce demandée existe
    If Not plageb.Find(mat, lookat:=xlWhole) Is Nothing Then

        'chargement dictionnaire stock
        For i = 2 To dls
            dict_stock(wss.Cells(i, 1).Value) = wss.Cells(i, 3)
        Next i
        compterpiece mat, plageb, dict_pieces, dict_stock

        'le dictionnaire des pièces raw nécessaires et leur quantité pour une pièce finale est constitué
        'on vérifie combien de pièces finales on peut faire
        mqp = 100000
        k = 5
        For Each cle In dict_pieces.keys
            k = k + 1
            Cells(k, 1) = cle
            Cells(k, 2) = dict_stock(cle)
            Cells(k, 3) = dict_pieces(cle)
            qp = Int(dict_stock(cle) / dict_pieces(cle))
            Cells(k, 4) = qp
            If qp < mqp Then mqp = qp
            Cells(k, 5) = mqp
        Next
        nap = mqp
    Else
        nap = "pièce non trouvée"
    End If
End Function
Sub compterpiece(mat, plage As Range, dict_pieces As Object, dict_stock As Object, Optional facteur_multiplicatif = 1)
    Dim piece As Range, composant$, nombrecomposant#
    For Each piece In plage
        If piece.Value = mat Then
            composant = piece.Offset(, 1).Value
            nombrecomposant = piece.Offset(, 2).Value
            If Left(composant, 3) = "RAW" Then
                dict_pieces(composant) = dict_pieces(composant) + facteur_multiplicatif * nombrecomposant
            Else
                compterpiece composant, plage, dict_pieces, dict_stock, facteur_multiplicatif * nombrecomposant
            End If
        End If
    Next piece
End Sub
Le 13/11/2019 à 18:20

merci, de rien

Le 14/11/2019 à 11:35

Bonjour H2so4,

Un grand merci pour ton aide.

Rechercher des sujets similaires à "calculer nmbre assemlblage possible"