XL 2016 Transfert de données d'un onglet à un autre avec condition.

[steph59940]

Bonjour le forum,

J'ai de nouveau besoin de vous. Je bloque sur mon projet.

Problème 1

j'ai une planification de fabrication (PJ) dans l'onglet "Base" de cette planif j'ai des réf avec la quantité à produire (en verte). J'ai un deuxième onglet ("Nomenclatures") où j'ai tous les composants nécessaires par réf avec les qtés pour faire un volet. Je souhaiterai que si la quantité dans "Base" est verte, elle se reporte dans "Nomenclatures" en colonne D en face de toutes les réfs correspondantes. Vous l'aurez compris le but étant de connaitre le besoin en composant pour fabriquer la réf dans les qtés demandées en colonne E onglet "Nomenclatures". mais pas avant d'avoir résolu le second problème si dessous.

Problème 2

Parfois, sur une même réf ex du fichier joint "P/HU150AB" j'ai une prod prévu et un ajustement de prod tous deux en vert. Je souhaiterai additionner ces deux valeurs avant transmission en colonne D devant les réf correspondantes.

Merci pour votre aide les geeks,

Stéphane.

 

[laurent950]

Re @Dranreb

Qu'elle est cette ligne de code ?
OK = Err.Number = 0
Elle a qu'elle action dans la procédure de votre code en Poste # 26
Au Niveau de la : Private Sub ONéCourant_Add

J'ai pas compris cela @Dranreb

 

[Dranreb]

Cette variable OK transmise ByRef par l'ObjetNommé qui a décrèté cet évènement Add lui permet de savoir si son ajout dans la collection s'est bien passé.

 

[job75]

laurent950 et Bernard vous ne comprenez pas que vous exaspérez tout le monde ?

Le forum n'est pas fait pour ça, vous pouvez toujours utiliser la messagerie privée.

 

[laurent950]

Cette variable OK transmise ByRef par l'ObjetNommé qui a décrèté cet évènement Add lui permet de savoir si son ajout dans la collection s'est bien passé.

Merci @Dranreb
C'est une instruction qui est astucieuse bien pensé @Dranreb vous êtes efficace, je vais apprendre cela aussi.
Votre exemple est vraiment très utile est bien construit pour l'exemple.
Le but est d'essayer de coder avec votre principe de module de classe la demande de cette discussion.

 

[laurent950]

Re Merci @Dranreb

Voici la solution final avec la variable collection dans le Module de classe. (Avec Variable Collection Géré par la classe) Solution trouvé avec l'aide apporté par @Dranreb

Il y a les deux solutions maintenant dans cette discussion
Depuis le Module standard (Variable Collection)
et
Depuis le Module de classe (Variable Collection)

Nota les Poste #22 et Poste #26, Sont très intéressant et d'une très grande utilité dans la compréhension du Modèle Objet en Classe créer par @Dranreb ainsi que toute les explications de @Dranreb qui sont d'une très grande qualité.

Un Très Très Grand Merci a @Dranreb

Module Standard : ProdPrévuEtUnAjustementModuleDeClasseCollectionDansModuleDeClasse

Option Explicit
Sub ProdPrévuEtUnAjustementModuleDeClasseCollectionDansModuleDeClasse()
Dim Refvolet As New Article     ' Equivalent de Redim preserve conserve les contenant
    'Set Refvolet = New Article ' Equivalent de Redim avec les tableaux perd le contenant
'Dim coll As New Collection      ' Equivalent de Redim preserve conserve les contenant
'    'Set coll = New Collection  ' Equivalent de Redim avec les tableaux perd le contenant
Dim wkb As Workbook
    Set wkb = Workbooks(ThisWorkbook.Name)
Dim wksBase As Worksheet
Dim wksNomenclatures As Worksheet
    Set wksBase = wkb.Worksheets("Base")
    Set wksNomenclatures = wkb.Worksheets("Nomenclatures")
Dim TBase, TNomenclatures As Variant
    TBase = wksBase.Range(wksBase.Cells(2, 1), wksBase.Cells(wksBase.Cells(65536, 1).End(xlUp).Row, 3)).Value2
    TNomenclatures = wksNomenclatures.Range(wksNomenclatures.Cells(2, 1), wksNomenclatures.Cells(wksNomenclatures.Cells(65536, 1).End(xlUp).Row, 3)).Value2
    ReDim Preserve TNomenclatures(LBound(TNomenclatures, 1) To UBound(TNomenclatures, 1), LBound(TNomenclatures, 2) To UBound(TNomenclatures, 2) + 1)
Dim Rgn As Range
Dim i As Integer
For i = LBound(TBase, 1) To UBound(TBase, 1)
     Set Rgn = wksBase.Range(wksBase.Cells(i + 1, 3), (wksBase.Cells(i + 1, 3)))
        If Rgn.Interior.ColorIndex = 4 Then
            Select Case TBase(i, 2)
                Case "Prod prévue"
                   Refvolet.Item TBase(i, 1), TBase(i, 3)
                Case "Ajustement prod"
                    Refvolet.Item TBase(i, 1), TBase(i, 3)
            End Select
        End If
Next i
' récupération des exemplaires stocké dans la Variable Collection !
Dim NbVoletProd As Article
Dim coll As Collection
On Error Resume Next
For i = LBound(TNomenclatures, 1) To UBound(TNomenclatures, 1)
    If TNomenclatures(i, 1) <> Empty Then
        Set coll = Refvolet.Conteneur
        Set NbVoletProd = coll.Item(TNomenclatures(i, 1))
            TNomenclatures(i, 4) = NbVoletProd.Resultat
        Set NbVoletProd = Nothing
    End If
Next i
On Error GoTo 0
    wksNomenclatures.Cells(2, 4).Resize(UBound(TNomenclatures, 1), 1).Value = Application.Index(TNomenclatures, , 4)
End Sub

Module de Classe : Article

Option Explicit
Private MclRes As Variant
Private MclRecopieRes As Variant
Private coll As Collection
Private Sub Class_Initialize()
   Set coll = New Collection
   End Sub
Public Function Item(ByVal Rub As Variant, Optional ByVal Res As Variant) As Article
On Error Resume Next
    Set Item = coll(Rub)
If Err.Number <> 0 Then
    Set Item = New Article
    MclRes = Empty
    Item.Resultat = Res
    coll.Add Item, Rub
Else
    Item.Resultat = Res
End If
On Error GoTo 0
End Function
Property Let Resultat(ByVal Res As Variant)
   MclRes = MclRes + Res
   Debug.Print MclRes
   End Property
Property Get Resultat() As Variant
   Resultat = MclRes
   End Property
Property Get Conteneur() As Collection
   Set Conteneur = coll
   End Property

Je fini cette discussion est poursuit sur une Autres pour des explication complémentaire donné par @Dranreb qui sont vraiment d'une très grande qualités

Merci

Laurent