Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

steph59940

XLDnaute Nouveau
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.
 

Pièces jointes

  • Planification Volets Std.xlsm
    342.2 KB · Affichages: 12
Trier par date Trier par votes

laurent950

XLDnaute Barbatruc
Bonsoir

steph59940 à dit:
Problème 2
Cliquez pour agrandir...

VB: 
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
 
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
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 :
Code: 
=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+
 

Pièces jointes

  • Planification Volets Std(1).xlsm
    368.5 KB · Affichages: 3
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
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" :
VB: 
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) :
VB: 
Function CouleurFond(c As Range)
CouleurFond = c.Interior.ColorIndex
End Function
A+
 

Pièces jointes

  • Planification Volets Std(2).xlsm
    354.8 KB · Affichages: 5
Vote positif 0 Vote négatif

laurent950

XLDnaute Barbatruc
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

Code: 
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"

VB: 
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
 
Vote positif 0 Vote négatif

laurent950

XLDnaute Barbatruc
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"
VB: 
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

Code: 
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
 

Pièces jointes

  • Planification Volets Std Module de Classe.xlsm
    341.3 KB · Affichages: 4
Vote positif 0 Vote négatif

laurent950

XLDnaute Barbatruc
Dranreb à dit:
À 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 !
Cliquez pour agrandir...
Voila l'idée
Depuis le module standard : Module1
Lorsque les conditions sont respecté
VB: 
            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é :
Code: 
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 :

Code: 
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
 
Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc
Ç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.
 
Dernière édition:
Vote positif 0 Vote négatif

laurent950

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

O
  • Question
XL 2013 Recopier automatique des valeurs d'un onglet vers un autre onglet selon critère
Réponses
2
Affichages
465
olivieroma
O
N
  • Résolu(e)
Microsoft 365 Remplir une ComboBox à 3 colonnes avec les données d'un TS
4 5 6
Réponses
78
Affichages
1 K
Dudu2
O
  • Résolu(e)
XL 2016 Transfert de données sous conditions
Réponses
4
Affichages
499
sylvanu
N
  • Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
444
Nel'
N
  • Question
Microsoft 365 VBA : copier / coller d'un onglet à l'autre en fonction d'une valeur
Réponses
8
Affichages
549
Lisette
A
  • Résolu(e)
XL 2016 Transfert de formule d'une feuille à une autre.
Réponses
2
Affichages
414
Al1_44
A
P
  • Question
Microsoft 365 Joindre un fichier PDF dans un mail + inclure date envoi du mail dans un autre onglet
Réponses
1
Affichages
472
kiki29
M
  • Question
Microsoft 365 Afficher les données d'un userform sur un autre userform
Réponses
3
Affichages
423
Manon71.
M
G
  • Question
Microsoft 365 Avoir des classeurs maitres et les procédures dans un autre classeur.
2
Réponses
18
Affichages
1 K
GClaire
G
  • Question
Autres Transfert des données d'un classeur à un autre
Réponses
5
Affichages
550
Oneida
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…