XL 2013 Mettre tous les materiels envoyés par destination.

Makbtpyou

XLDnaute Nouveau
Bonsoir à tous, jai un fichier comportant le mouvement des materiaux de construction destinés à plusieurs chantiers dans un meme tableau,je voudrais cepandant, mettre par chantier tous les materiaux obtenus pour connaitre exacrement la quantité luvrée de chaque .
Ci joint un modele de fichier.
Je voudrai connaitre la methodologie pour resoudre ce type de probleme.
Merci
 

Pièces jointes

  • STOCK GENERAL ENIMAC.xlsx
    243.3 KB · Affichages: 13

sousou

XLDnaute Barbatruc
Bonjour,
Le principe de base, me semble t-il aurait été de n'avoir qu'une seule base de données comportant un champs désignation et un chantier en plus du reste.
Un tableau croisé par chantier aurait fait le travail
Il est toujours possible de développer une macro pour obtenir ce résultat si tu donne la forme sous laquelle tu veux le voir et l'utiliser
 

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Makbtpyou, Sousou, bonjour le forum,

En pièce jointe ton fichier modifié. J'ai rajouté un onglet État en première position. Le code dans le composant ThisWorkbook permet, à l'ouverture du classeur, de lister toutes les destinations dans la cellule A1 de cet onglet :

VB:
Private Sub Workbook_Open()

'****************************************************************************************************************
'ce code, à l'ouverture du classeur, permet d'afficher en A1 de l'onglet État la liste de toutes les destinations
'****************************************************************************************************************

Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim L As String 'déclare la variable L (Liste)

Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each O In Worksheets 'boucle 1 : sur tous les onglets O du classeur
    Select Case O.Name 'agit en fonction du nom de l'onglet de la boucle
        Case "État", "STOCKS" 'cas où rien ne se passe
        Case Else 'tous les autres cas
            TV = O.Range("A5").CurrentRegion 'définit le tableau des valeurs TV
            For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
                'si la donnée ligne I colonne 3 de TV (DESTINATION) n'est pas vide, alimente le dictionnaire D avec cette donnée
                If TV(I, 3) <> "" Then D(TV(I, 3)) = ""
            Next I 'prochaine ligne de la boucle 2
        End Select 'fin de l'action en fonction du nom de l'onglet de la boucle
Next O 'prochain onglet de la boucle 1
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
L = Join(TMP, ",") 'crée la liste L
Set O = Worksheets("État") 'définit l'onglet O
With O.Range("A1").Validation 'prend la compte la validation de donnée de la cellule A1 de l'onglet O
    .Delete 'supprime une éventuelle validation existente
    .Add xlValidateList, Formula1:=L 'définit la liste L comme liste de validation de donnéed
End With 'fin de la prose en compte de la validation de donnée de la cellule A1 de l'onglet O
End Sub

Il ne te reste plus qu'à sélectionner une destination dans A1 de l'onglet État pour qu'apparaissent les données à partir de A6 grâce au code dans le composant VBA Feuil59 (État) :
Code:
Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)

If Target.Address <> "$A$1" Then Exit Sub 'si le changement a lieu ailleurs qu'en A1, sort de la procédure
Rows("6:" & Application.Rows.Count).Delete 'supprime les anciennes données
If Target.Value = "" Then Exit Sub 'si A1 est effacée, sort de la procédure
'Set D = CreateObject("Scripting.Dictionary")
For Each O In Worksheets 'boucle 1 : sur tous les onglets O
    Select Case O.Name 'agit en fonction du nom de l'onglet de la boucle
        Case "État", "STOCKS" 'cas où rien ne se passe
        Case Else 'tous les autres cas
            TV = O.Range("A5").CurrentRegion 'définit le tableau des valeurs TV
            For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
                'condition : si la destination de la donnée ligne I colonne 3 de TV correspond à la valeur de la cellule A1
                If TV(I, 3) = Target.Value Then
                    Li = IIf(Range("A6").Value = "", 6, Cells(Application.Rows.Count, "A").End(xlUp).Row + 1) 'définit la ligne LI
                    Cells(Li, "A").Value = O.Name 'renvoie le nom de l'onglet O dans la cellule ligne LI colonne A
                    'renvoie dans la cellule ligne LI colonne B redimensionnée la ligne I du tableua TV
                    Cells(Li, "B").Resize(1, UBound(TV, 2)).Value = Application.Index(TV, I)
                End If 'fin de la condition
            Next I 'prochaine ligne de la boucle 2
        End Select 'fin de l'action en fonction du nom de l'onglet de la boucle
Next O 'prochain onglet de la boucle 1
End Sub

Attention : Tu remarqueras qu'il existe des chantiers au nom extravagant... Il faudra corriger dans tes tableaux. Exemple Chantier BINETA et CHNATIER BINETA, etc.
Le fichier :
 

Pièces jointes

  • Makbtpyou_ED_v01.xlsm
    274.4 KB · Affichages: 9

Makbtpyou

XLDnaute Nouveau
Bonjour Makbtpyou, Sousou, bonjour le forum,

En pièce jointe ton fichier modifié. J'ai rajouté un onglet État en première position. Le code dans le composant ThisWorkbook permet, à l'ouverture du classeur, de lister toutes les destinations dans la cellule A1 de cet onglet :

VB:
Private Sub Workbook_Open()

'****************************************************************************************************************
'ce code, à l'ouverture du classeur, permet d'afficher en A1 de l'onglet État la liste de toutes les destinations
'****************************************************************************************************************

Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim L As String 'déclare la variable L (Liste)

Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each O In Worksheets 'boucle 1 : sur tous les onglets O du classeur
    Select Case O.Name 'agit en fonction du nom de l'onglet de la boucle
        Case "État", "STOCKS" 'cas où rien ne se passe
        Case Else 'tous les autres cas
            TV = O.Range("A5").CurrentRegion 'définit le tableau des valeurs TV
            For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
                'si la donnée ligne I colonne 3 de TV (DESTINATION) n'est pas vide, alimente le dictionnaire D avec cette donnée
                If TV(I, 3) <> "" Then D(TV(I, 3)) = ""
            Next I 'prochaine ligne de la boucle 2
        End Select 'fin de l'action en fonction du nom de l'onglet de la boucle
Next O 'prochain onglet de la boucle 1
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
L = Join(TMP, ",") 'crée la liste L
Set O = Worksheets("État") 'définit l'onglet O
With O.Range("A1").Validation 'prend la compte la validation de donnée de la cellule A1 de l'onglet O
    .Delete 'supprime une éventuelle validation existente
    .Add xlValidateList, Formula1:=L 'définit la liste L comme liste de validation de donnéed
End With 'fin de la prose en compte de la validation de donnée de la cellule A1 de l'onglet O
End Sub

Il ne te reste plus qu'à sélectionner une destination dans A1 de l'onglet État pour qu'apparaissent les données à partir de A6 grâce au code dans le composant VBA Feuil59 (État) :
Code:
Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)

If Target.Address <> "$A$1" Then Exit Sub 'si le changement a lieu ailleurs qu'en A1, sort de la procédure
Rows("6:" & Application.Rows.Count).Delete 'supprime les anciennes données
If Target.Value = "" Then Exit Sub 'si A1 est effacée, sort de la procédure
'Set D = CreateObject("Scripting.Dictionary")
For Each O In Worksheets 'boucle 1 : sur tous les onglets O
    Select Case O.Name 'agit en fonction du nom de l'onglet de la boucle
        Case "État", "STOCKS" 'cas où rien ne se passe
        Case Else 'tous les autres cas
            TV = O.Range("A5").CurrentRegion 'définit le tableau des valeurs TV
            For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
                'condition : si la destination de la donnée ligne I colonne 3 de TV correspond à la valeur de la cellule A1
                If TV(I, 3) = Target.Value Then
                    Li = IIf(Range("A6").Value = "", 6, Cells(Application.Rows.Count, "A").End(xlUp).Row + 1) 'définit la ligne LI
                    Cells(Li, "A").Value = O.Name 'renvoie le nom de l'onglet O dans la cellule ligne LI colonne A
                    'renvoie dans la cellule ligne LI colonne B redimensionnée la ligne I du tableua TV
                    Cells(Li, "B").Resize(1, UBound(TV, 2)).Value = Application.Index(TV, I)
                End If 'fin de la condition
            Next I 'prochaine ligne de la boucle 2
        End Select 'fin de l'action en fonction du nom de l'onglet de la boucle
Next O 'prochain onglet de la boucle 1
End Sub

Attention : Tu remarqueras qu'il existe des chantiers au nom extravagant... Il faudra corriger dans tes tableaux. Exemple Chantier BINETA et CHNATIER BINETA, etc.
Le fichier :
Bonsoir, ici les fichiers reels à partir desquels il faut vraiment se baser.
Les versions corrigées de ces fichiers me feraient plaisir.
Merci d'avance.
 

Pièces jointes

  • PLAQUISTENEW.xlsx
    216.5 KB · Affichages: 4
  • PEINTURE.xlsx
    223.5 KB · Affichages: 3
  • DIVERSITENEW.xlsx
    594.5 KB · Affichages: 2
  • ELECTRICITENEW.xlsx
    242.1 KB · Affichages: 2

Statistiques des forums

Discussions
312 215
Messages
2 086 322
Membres
103 178
dernier inscrit
BERSEB50