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.

 

[Dranreb]

Vous n'avez as fait ce que j'ai dit s'il n'y a plus d'arborescence à gérer.

 

[laurent950]

Il faut faire une collection pour chaque Article.

Voila ou je suis arrivé mais j'arrive pas a consigner le résultat tous s'additionne

comment on fait pour avoir des exemplaires !

MclRes = MclRes + Res

par exemple cette variable "MclRes" c'est la même qui s'incrémente... Il faut raisonner en exemplaire comment cloisonner
Exemplaire : P/HU150AB ---- >>> Soit la quantité pour cet exemplaire (MclRes)
Exemplaire : P/HU240AG ---- >>> Soit la quantité pour cet exemplaire (MclRes)
Exemplaire : P/VF17/15ALUB ---- >>> Soit la quantité pour cet exemplaire (MclRes)

Mais MclRes cette variable n'est pas cloisonner par exemplaire...
Comment vous avez fait pour créer des exemplaires
j'ai pas encore le schéma c'est complexe quand même, mais une fois que l'on a compris cela ca deviens intéressant

Mille Merci @Dranreb pour toute votre aide apporté

Je continu a chercher

 

[Dranreb]

Non, il faut faire une collection dans un module de classe Articles
Ou alors dans votre procédure principale tout simplement et vous gérez applicativement les Add de vos objets Article.
Un module de classe Articles n'est intéressant qui si vous voulez toujours pouvoir obtenir un Article d'une certaine référence même s'il n'existe pas encore. Mais si vous préférez le gérer vous même dans votre programmation applicative vous n'avez plus besoin d'une programmation de service transparente pour elle.

 

[laurent950]

Non, il faut faire une collection dans un module de classe Articles

Je vais essayer comme cela

Puis ensuite avec les autres propositions pour apprendre. demain je poursuit le code

Merci @Dranreb

 

[Dranreb]

Bonjour
Une nouvelle collection y est créée dans chaque exemplaire pour les exemplaires enfants
S'il n'y a plus de d'arborescence, il peut y avoir à la rigueur une collection parent unique dans le programme principal ou dans un objet parent commun. Si vous voulez que les membres la connaissent pour pouvoir s'y insérer ou s'en évacuer il faut veiller à ce qu'elle soit définie, mais pour chacun la même.

 

[laurent950]

Bonjour @Dranreb

Voila j'ai des question :
* Ce que je comprend
Non, il faut faire une collection dans un module de classe Articles = Il faut créer un Module de classe à Part pour y stocker une variable collection (Dans ce Module de Classe) ?

Ou alors dans votre procédure principale tout simplement et vous gérez applicativement les Add de vos objets Article. = Il faut créer cette Variable Collection dans le Module Standard ?

Un module de classe Articles n'est intéressant qui si vous voulez toujours pouvoir obtenir un Article d'une certaine référence même s'il n'existe pas encore = C'est liée a cette Variable collection qu'il faut créer dans un module de classe Article indépendant ?

Mais si vous préférez le gérer vous même dans votre programmation applicative vous n'avez plus besoin d'une programmation de service transparente pour elle. = si je traduit (c'est le module standard pour programmation applicative) ?
Puis lorsque vous dite (vous n'avez plus besoin d'une programmation de service transparente pour elle. = c'est d'un module de classe dont vous parler ici ?

Pour en revenir à cela : Une nouvelle collection y est créée dans chaque exemplaire pour les exemplaires enfants

Ici Justement comment on y arrive pour : S'il n'y a plus de d'arborescence, il peut y avoir à la rigueur une collection parent unique dans le programme principal ou dans un objet parent commun. Si vous voulez que les membres la connaissent pour pouvoir s'y insérer ou s'en évacuer il faut veiller à ce qu'elle soit définie, mais pour chacun la même.

J'ai avancer dans le module de classe je vous Poste :
Pour l'instant je n'ai qu'un seul exemplaire et donc un seule Item pour la Variable collection.

Mais j'ai compris les chemins, les Objets, il me manque encore des schéma, c'est pas si simple et vous êtes hyper fort et astucieux précis est super mais vraiment super efficace.

Comment vous avez fait @Dranreb pour conserver cette Variable Collection dans votre module de classe standard... elle était imbriqué

Chapitre 1 = Une collection
Sous Chapitre 1.1
Sous Chapitre 1.2
Sous Chapitre 1.3
Chapitre 2 = Une collection
Sous Chapitre 2.1
Sous Chapitre 2.2
Sous Chapitre 2.3
Chapitre 3 = Une collection
Sous Chapitre 3.1
Sous Chapitre 3.2
Sous Chapitre 3.3

l'idée ici c'est une collection pour :
P/HU150AB = Une collection
P/HU240AG = Une collection
P/VF17/15ALUB = Une collection

J'y arrive que pour une seule :
P/HU150AB = Une collection
Puis a la création d'une nouvelle collection elle est écrasé par la nouvelle
je perd cette Variable Coll de type Collection
C'est la même chose que les Variable Tableau (si on ne Note pas Redim Preserve)
Toutes les données se vide.
et donc a la nouvelle initialisation je perd tous
Set Coll = New Collection
Coll est Vide

Comment les Imbriqués c'est Variable Col de Type Collection

Par exemple la Principal qui inclus toutes les autres (ensuite il faut votre principe de récurcivité) pour s'y retrouver

Coll
--Coll = P/HU150AB
----Coll = P/HU240AG
------Coll = P/VF17/15ALUB

Il y a beaucoup a Modifier dans le code que j'ai commencé @Dranreb ?

Option Explicit
Private mdl As Article
Private Coll As Collection
Private MclRes As Variant
Private MclRecopieRes As Variant
Public Sub InitCollection()
    Set Coll = New Collection
   End Sub
Public Sub Item(ByVal Rub As Variant, Optional ByVal Res As Variant)
Debug.Print Rub
On Error Resume Next
    Set mdl = Coll(Rub)
If Err.Number <> 0 Then
    Me.InitCollection
    MclRes = Empty
    Me.Resultat = Res
    Coll.Add Me, Rub
Else
    Me.Resultat = Res
End If
On Error GoTo 0
End Sub

Je vous Poste @Dranreb

 

[Dranreb]

Je joins un dispositif à deux modules de classe et j'ouvre votre classeur.

 

[Dranreb]

Ce n'est pas bon ce que vous avez fait. Vous créez une nouvelle collection dans la méthode item pour chaque exemplaire au lieu de spécifier la collection centrale commune.
Je vous dis, il vaudrait mieux qu'elle ne soit pas dans ses membres.

Édition; Non c'est pire que ça : vous effacez par une nouvelle la collection à chaque ajout d'item, sans initialiser la collection de l'Item par contre.

Vraiment, ne faites plus comme ça si ce n'est plus arborescent.

Édition: Dans la version arborescente j'arrivais à garder la collection racine parce qu'elle était dans une Rubrique racine appelée RubGlobale que je ne réinitialisais jamais. J'utilisai donc toujours sa même collection racine, celle des autres était toujours pour les Rubrique enfants.

 

[laurent950]

Bonjour @Dranreb

Très content de vous lire, je suis arrivé a faire fonctionner le code avec :
Une Variable Collection Initialisé dans le Module Standard
Cette Variable est envoyé dans le Module de Classe est gérer dans le Module de Classe.
Le système fonctionne très bien, je me suis inspiré de votre astuce avec le code Arborescence.
J'ai compris cela aussi :

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

Alors voila ce que j'ai fait, je n'ai pas encore lu votre code en Poste #22
Je découvre votre Poste #23

Je vous montre mon travail je Poste le code :

Module Standard : ProdPrévuEtUnAjustementModuleDeClasse

Option Explicit
Sub ProdPrévuEtUnAjustementModuleDeClasse()
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"
                   Set coll = Refvolet.Item(TBase(i, 1), coll, TBase(i, 3))
                Case "Ajustement prod"
                    Set coll = Refvolet.Item(TBase(i, 1), coll, TBase(i, 3))
            End Select
        End If
Next i
On Error Resume Next
Dim NbVoletProd As Article
For i = LBound(TNomenclatures, 1) To UBound(TNomenclatures, 1)
    If TNomenclatures(i, 1) <> Empty Then
        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 mdl As Article
Private MclRes As Variant
Private MclRecopieRes As Variant
Public Function Item(ByVal Rub As Variant, ByVal coll As Collection, Optional ByVal Res As Variant) As Collection
Dim MclTemp As Article
Debug.Print Rub
On Error Resume Next
    Set mdl = coll(Rub)
If Err.Number <> 0 Then
    Set MclTemp = New Article
    MclRes = Empty
    MclTemp.Resultat = Res
    coll.Add MclTemp, Rub
Else
    mdl.Resultat = Res
End If
On Error GoTo 0
Set Item = coll
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

 

[job75]

Bonjour laurent950, Bernard,

J'avoue ne pas comprendre ce que vous cherchez à faire.

Avec le fichier de mon post #4 les 3436 formules se recalculent chez moi en 26 millièmes de seconde.

Si l'on veut aller un peu plus vite on utilisera ce code très classique du fichier (3) :

Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, tablo, i&, v, x$, P As Range, resu()
'---liste sans doublon---
Set d = CreateObject("Scripting.Dictionary")
tablo = Sheets("Base").UsedRange.Resize(, 3) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    If tablo(i, 2) <> "Reste à fabriquer" Then
        v = tablo(i, 3)
        If IsNumeric(v) Then x = CStr(tablo(i, 1)): d(x) = d(x) + CDbl(v)
    End If
Next
'---tableau des résultats---
Set P = UsedRange
tablo = P.Resize(, 4) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 1)
resu(1, 1) = tablo(1, 4)
For i = 2 To UBound(resu)
    x = CStr(tablo(i, 1))
    If d.exists(x) Then resu(i, 1) = d(x)
Next
'---restitution---
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
P(1, 4).Resize(UBound(resu)) = resu
Application.EnableEvents = True 'réactive les évènements
End Sub

Il s'exécute chez moi en 21 millièmes de seconde.

Edit : j'ai corrigé une coquille...

A+

 

[Dranreb]

Un peu étoffé mon truc.

 

[laurent950]

Avec le fichier de mon post #4 les 3436 formules se recalculent chez moi en 26 millièmes de seconde.

En Supprimant ce tableau resu
Vous gagner combien par curiosité @job75
Comme le tableau est déjà existant Tablo colonne 4 vide, je pense que le Tableau resu n'est pas nécessaire.

Option 1 (Supprime le Tableau resu)

'---tableau des résultats---
Set P = UsedRange
tablo = P.Resize(, 4) 'matrice, plus rapide
'ReDim resu(1 To UBound(tablo), 1 To 1)
'resu(1, 1) = tablo(1, 4)
For i = 2 To UBound(tablo, 1)
    x = CStr(tablo(i, 1))
    If d.exists(x) Then tablo(i, 4) = d(x)
Next
'---restitution---
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
'P(1, 4).Resize(UBound(resu)) = resu
P.Cells(1, 4).Resize(UBound(tablo, 1), 1).Value = Application.Index(tablo, , 4)
Application.EnableEvents = True 'réactive les évènements

Option 2 (Supprime le Tableau resu) + Elimine le test sur l'existence de la clé (d.exists(x))

'---tableau des résultats---
Set P = UsedRange
tablo = P.Resize(, 4) 'matrice, plus rapide
On Error Resume Next
For i = 2 To UBound(tablo, 1)
    tablo(i, 4) = d(CStr(tablo(i, 1)))
Next
On Error GoTo 0

'---restitution---
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
P.Cells(1, 4).Resize(UBound(tablo, 1), 1).Value = Application.Index(tablo, , 4)
Application.EnableEvents = True 'réactive les évènements

 

[laurent950]

Re @Dranreb

Un peu étoffé mon truc.

Merci je continue sur la lancé pour bien comprendre le Modèle Objet avec les classes et les utilisés.

Ce fichier est un complément :
Le premier en Poste # 22
Puis celui du Poste # 26

Il y a de quoi faire, je vais prendre le temps de bien étudier cela, c'est vraiment très intéressant.

L'objectif est d'inclure cette variable collection dans le Module de Classe, je poursuit et essaie de faire le code, l'exemple de cette discussion est super pour l'exemple.

Mille Merci Bernard

Laurent

 

[job75]

En Supprimant ce tableau resu
Vous gagner combien par curiosité @job75
Comme le tableau est déjà existant Tablo colonne 4 vide, je pense que le Tableau resu n'est pas nécessaire.

Supprimer le tableau resu ne fera pratiquement rien gagner.

Et il est nécessaire car la colonne D n'est pas forcément vide avant que la macro s'exécute.

laurent950 et Bernard c'est gentil de faire joujou mais ce serait plus gentil de dire ce que vous voulez faire.

 

[Dranreb]

Oh moi je ne fais que montrer des façons de programmer comme le souhaite laurent950, en insistant beaucoup là dessus. Je n'ai jamais dit que c'était comme ça qu'il fallait traiter des données déjà stockées sur leurs supports naturels que sont les plages de cellules. À part une légère tendance vers ça avec ma fonction Gigogne, je ne les traite généralement pas ainsi. J'ai rarement vu une pertinence à les stocker dans des objets. C'est plus réservé à des objets plus techniques en vue d'une manipulation indirecte plus aisée.