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.

 

[steph59940]

Hello,

Problème 1 résolu, reste le 2...

Stéphane.

 

[laurent950]

Bonsoir

Problème 2

Option Explicit
Sub ProdPrévuEtUnAjustement()
Dim wbtemp As Workbook
    Set wbtemp = Workbooks(ThisWorkbook.Name)
Dim wstemp As Worksheet
    Set wstemp = wbtemp.Worksheets("Base")
Dim data As Variant
data = wstemp.Range(wstemp.Cells(2, 1), wstemp.Cells(wstemp.Cells(65536, 1).End(xlUp).Row, 3)).Value2
ReDim Preserve data(LBound(data, 1) To UBound(data, 1), LBound(data, 2) To UBound(data, 2) + 1)
Dim Coll As Collection
Dim i, j As Integer
Set Coll = New Collection
For i = LBound(data, 1) To UBound(data, 1)
On Error Resume Next
   Coll.Add (data(i, 1) & Chr(27) & i), Key:=data(i, 1)
On Error GoTo 0
Next i
For i = 1 To Coll.Count
    For j = LBound(data, 1) To UBound(data, 1)
        If data(j, 1) = Split(Coll.Item(i), Chr(27))(0) Then
            If data(j, 2) = "Ajustement prod" Or data(j, 2) = "Prod prévue" Then
                data(CInt(Split(Coll.Item(i), Chr(27))(1)), 4) = data(CInt(Split(Coll.Item(i), Chr(27))(1)), 4) + data(j, 3)
            End If
        End If
    Next j
Next i
wstemp.Cells(3, 4).Resize(UBound(data, 1), 1).Value = Application.Index(data, , 4)
End Sub

 

[job75]

Bonjour steph59940, laurent950, le forum,

Je ne vois pas comment on peut résoudre le problème 1 sans résoudre le 2 mais bon...

Sans s'occuper des couleurs, formule en D2 de la feuille "Nomenclatures", à tirer vers le bas :

=SOMME.SI.ENS(Base!C:C;Base!A:A;A2;Base!B:B;"<>Reste à fabriquer")

Format Standard;; en colonne D pour masquer les valeurs zéro.

A+

 

[job75]

Maintenant si l'on veut rechercher la couleur verte il faut du VBA, voyez ce fichier (2).

C'est encore la fonction SOMME.SI.ENS qui est utilisée, le code de la feuille "Nomenclatures" :

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

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
With Sheets("Base").UsedRange
    .Cells(1).EntireColumn.Insert 'colonne auxiliaire
    .Columns(0) = "=CouleurFond(RC[3])" 'fonction VBA
    .Columns(0).Name = "Couleur" 'plage nommée
    .Columns(1).Name = "Article"
    .Columns(3).Name = "Total"
    With Range("D2:D" & Range("A" & Rows.Count).End(xlUp).Row)
        If .Row > 1 Then
            .Formula = "=IFERROR(1/(1/SUMIFS(Total,Couleur,4,Article,A2)),"""")" 'SOMME.SI.ENS
            .Value = .Value 'supprime les formules
        End If
    End With
    .Cells(1, 0).EntireColumn.Delete 'supprime la colonne auxiliaire
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

La colonne D est mise à jour quand on modifie ou valide une cellule quelconque ou qu'on active la feuille.

Le code de la fonction VBA CouleurFond doit être placé dans un module standard (Module1) :

Function CouleurFond(c As Range)
CouleurFond = c.Interior.ColorIndex
End Function

A+

 

[steph59940]

Bonsoir,

Merci pour vos réponses, mon problème est résolu.

A Bientôt,
Stéphane.

 

[laurent950]

Bonsoir,

Feuille Base :
Lorsque la couleur est rouge = la quantité n'est pas prise en compte dans l'addition
Lorsque la couleur est vert = la quantité est prise n compte dans l'addition

Exemple 1 :
Feuille Base :
Article : "P/HU150AB"
* Prod prévue      (Rouge) = 30  (cette quantité n'est pas prise en compte)
* Ajustement prod  (Vert)  = 30
                     somme = 30
                    
Dans la colonne D de la Feuille Nomenclatures la quantité 30 sera renseigné pour chaque Réf volet "P/HU150AB"

Exemple 2 :
Feuille Base :
Article : "P/HU150AB"
* Prod prévue      (Vert) = 30
* Ajustement prod  (Vert) = 30
                    somme = 60
                    
Dans la colonne D de la Feuille Nomenclatures la quantité 60 sera renseigné pour chaque Réf volet "P/HU150AB"

Feuille Nomenclatures :
La somme est renvoyé dans la colonne D en face de chaque "Réf volet"

Option Explicit
Sub ProdPrévuEtUnAjustement()
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
    ReDim Preserve TBase(LBound(TBase, 1) To UBound(TBase, 1), LBound(TBase, 2) To UBound(TBase, 2) + 1)
    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 Coll As Collection
Dim i, j As Integer
Set Coll = New Collection
For i = LBound(TBase, 1) To UBound(TBase, 1)
On Error Resume Next
   Coll.Add (TBase(i, 1) & Chr(27) & i), Key:=TBase(i, 1)
On Error GoTo 0
Next i
For i = 1 To Coll.Count
    For j = LBound(TBase, 1) To UBound(TBase, 1)
        If TBase(j, 1) = Split(Coll.Item(i), Chr(27))(0) Then
            If TBase(j, 2) = "Ajustement prod" Or TBase(j, 2) = "Prod prévue" Then
                Set Rgn = wksBase.Range(wksBase.Cells(j + 1, 3), (wksBase.Cells(j + 1, 3)))
                If Rgn.Interior.ColorIndex = 4 Then
                    TBase(CInt(Split(Coll.Item(i), Chr(27))(1)), 4) = TBase(CInt(Split(Coll.Item(i), Chr(27))(1)), 4) + TBase(j, 3)
                End If
            End If
        End If
    Next j
Next i
' Remplire la Colonne D "Nomemclature"
For i = LBound(TBase, 1) To UBound(TBase, 1) Step 3
    For j = LBound(TNomenclatures, 1) To UBound(TNomenclatures, 1)
        If TBase(i, 1) = TNomenclatures(j, 1) Then
            TNomenclatures(j, 4) = TBase(i, 4)
        End If
    Next j
Next i
wksNomenclatures.Cells(2, 4).Resize(UBound(TNomenclatures, 1), 1).Value = Application.Index(TNomenclatures, , 4)
End Sub

Laurent

 

[job75]

Merci pour vos réponses, mon problème est résolu.

J'espère que vous utilisez la solution de mon post #4 car c'est de très loin la solution la plus simple.

 

[laurent950]

Bonsoir,
j'ai tenter de réalisé ce code en Module de Classe et Variable Collection. Pour le moment j'ai pas encore finaliser je Poste le fichier et le code (Module de Classe non finalisé)

Module Standard "Module1"

Option Explicit
Sub ProdPrévuEtUnAjustementModuleDeClasse()
Dim Article As New Classe1
    'Set Article = New Classe1
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
Dim Rgn As Range
Dim i, j As Integer
Article.InitCollection
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 Article = Article.Item(TBase(i, 1), TBase(i, 3))
                Case "Ajustement prod"
                    Set Article = Article.Item(TBase(i, 1), TBase(i, 3))
            End Select
        End If
Next i
For j = LBound(TNomenclatures, 1) To UBound(TNomenclatures, 1)
        Article.LectureCollection = TNomenclatures(j, 1)
        TNomenclatures(j, 4) = Article.LectureCollection(TNomenclatures(j, 1))
Next j
wksNomenclatures.Cells(2, 4).Resize(UBound(TNomenclatures, 1), 1).Value = Application.Index(TNomenclatures, , 4)
End Sub

Le Module de Classe : Classe1

Option Explicit
Private Coll As Collection
Private MclRes As String
Private MclRecopieRes As Long
Public Sub InitCollection()
    Set Coll = New Collection
   End Sub
Public Function Item(ByVal Rub As String, Optional ByVal Res As Long) As Classe1
On Error Resume Next
  Set Item = Coll(Rub)
  Item.Resultat = Res
If Err.Number <> 0 Then
  Me.Resultat = Res
  Coll.Add Me, Rub
End If
On Error GoTo 0
End Function
Property Let Resultat(ByVal Res As String)
   Res = Res + Res
   MclRes = Res
   End Property
Property Get Resultat() As String
   Resultat = MclRes
   End Property
Property Let LectureCollection(ByVal Rub As Variant)
Dim Obj As Classe1
    Set Obj = Coll(Rub)
    MclRecopieRes = Obj.Resultat
   End Property
Property Get LectureCollection() As Variant
    LectureCollection = MclRecopieRes
   End Property

Pour Info le code en Poste #7 (Fonctionne bien) :
Module Standard : ProdPrévuEtUnAjustement

Fichier Joint

 

[Dranreb]

Bonsoir.
À quoi ça rime dans la Public Function Item d'ajouter à sa collection l'exemplaire interrogé lui même ???
Dans la programmation analogue que je vous avais proposée, j'en créais un nouveau !

 

[laurent950]

À quoi ça rime dans la Public Function Item d'ajouter à sa collection l'exemplaire interrogé lui même ???
Dans la programmation analogue que je vous avais proposée, j'en créais un nouveau !

Voila l'idée
Depuis le module standard : Module1
Lorsque les conditions sont respecté

            Select Case TBase(i, 2)
                Case "Prod prévue"
                    Set Article = Article.Item(TBase(i, 1), TBase(i, 3))
                Case "Ajustement prod"
                    Set Article = Article.Item(TBase(i, 1), TBase(i, 3))
            End Select

j'envois dans le module de classe :
la clé qui correspond a l'article : TBase(i, 1)
Et la quantité : TBase(i,3)

Je traduit ce que j'ai imaginé :

Public Function Item(ByVal Rub As String, Optional ByVal Res As Long) As Classe1
On Error Resume Next
' Si il y a une clé pour la collection, alors je récupére l'exemplaire.
  Set Item = Coll(Rub)
  ' j'envois la quantité qui sera donc additionné (si besoin) puis stoké dans l'exemplaire
  Item.Resultat = Res
If Err.Number <> 0 Then
si la collection n'a pas de clé Alors :
' J'envois la quantité qui sera donc additionné (si besoin) puis stoké dans l'exemplaire
  Me.Resultat = Res
  Puis je stock cette exemplaire dans la collection
  Coll.Add Me, Rub
End If

Je gére avec la gestion des erreurs, l'un ou l'autres

Ici :

Property Let Resultat(ByVal Res As String)
' l'idée c'est l'addition en
  Récupérent l'exemplaire comme expliqué ci-dessus
   Res = Res + Res
   MclRes = Res
   End Property

Comment expliquer :
Par exemple si je redimensionne une variable tableau avec des valeurs avec :
Redim Tabl(1 to 5,1 to 10)
Je perd toutes ces valeurs
je dois utilisé :
Redim Preserve Tabl(1 to 5,1 to 10)

Bien justement j'aimerais comprendre le schéma pour ne pas perdre le contenant de cette variable collection.

Je me suis perdu : voila pourquoi : j'ai fais cette aberration dans la Public Function Item d'ajouter à sa collection l'exemplaire interrogé lui même ???


Enfin c'est l'idée @Dranreb

 

[Dranreb]

Ça ne peut pas marcher.
En explorant la collection d'un niveau, donc des Class1 du niveau suivant, vous allez retomber sur le même. Ça peut durer longtemps à se mordre la queue comme ça !
Mais peut être ne voulez vous pas d'arborescence pour ce nouveau cas.
Dans ce cas créez deux modules de classe un Articles portant la collection et un Article pour ses membres. Comme le fait toujours Excel en somme.

 

[laurent950]

Déjà merci sur cette éclaircissement.

Mais alors y a t'il une astuce pour stocké tous les exemplaire dans cette variable collection. puis aller rechercher les exemplaires pour utiliser (par exemple le résultat de l'addition) qui est stocké dans l'exemplaire.

C'est quoi le schéma ?
comment on fait pour alimenter cette variable collection de tous ces exemplaire ? sans rien perdre

Votre système est super vous avez réussit a stocké tous dans la variable collection mais j'ai pas le schéma encore c'est facile et complexe il faut juste comprendre l'astuce

 

[Dranreb]

Par une méthode Item dans le Articles et une méthode Ajouter dans le Article.

 

[laurent950]

J'en suis a incompatibilité de type