Création d'un tableau d’énumération et recherche de présence
Bonjour à tous,
Tout d'abord, je tenais à dire que je n'ai pas de formation en excel mais il me faut m'en servir pour le boulot (en chimie, rien à voir).
De ce fait, je me tourne vers vous pour m'aider à améliorer (niveau temps) le processus qui est actuellement en place au sein de ma société.
Donc, ceci étant dit, mon souhait est le suivant (tableau joint) :
Il me faudrait une macro ("Enumeration") qui me permettrait de créer des tableaux avec 3 Entrées distinctes puis de les compléter en fonction de la présence ou non de ces Entrées créées.
Avec plus de précision et d'après l'exemple :
Mon tableau comprend 5 feuilles (Tableau, liste_R1, liste_R2, liste_R3 et Enum_filtre).
- J'aimerais tout d'abord que la feuille Tableau soit créée automatiquement à partir des feuilles liste_R1, liste_R2 et liste_R3 (le nombre de ligne pouvant varié) avec pour chaque R1, la liste des R2 en ligne et la liste des R3 en colonne.
Dans l'exemple, j'obtiendrais à la fin, 3 tableaux (3 R1 différents) de 3 lignes (3 R2) et 10 colonnes (10 R3, voir Exemple 1.jpg joint).
Idéalement, la mise en page (remplissage + bordures) se ferait également.
- Ensuite, le remplissage (visuel) proprement dit de ce tableau serait en fait une recherche depuis la feuille Enum_filtre (colonnes B, C et D) de ces 3 entrées créées [matrice].
Dans l'exemple:
. Dans la feuille Tableau, la case B2 correspond à R1_1, R2_1 et cap_prod_01.
Si on recherche cet ensemble dans une ligne de la feuille Enum_filtre, on la trouve en ligne 2.
La case reste blanche et on passe à la suivante.
. Si les trois entrées ne sont pas trouvées ensemble sur une même ligne de la feuille Enum_filtre, la case est noircie.
Cette opération est à effectuer pour l'ensemble des tableaux jusqu'à obtenir quelque chose comme dans l'Exemple 2.jpg.
Voilà, je pense avoir tout détaillé mon "souhait".
Je me tiens à disposition pour plus d'information et vous remercie d'avance pour votre aide.
Bonne journée,
Epohiel
Bonjour Epohiel, bonjour le forum,
En pièce jointe ton fichier modifié avec le code ci-dessous. Dans l'onglet Tableau, clique sur le bouton Création des Tableaux... Je n'obtiens pas le même résultat que ta capture d'écran mais, après une rapide vérification, il semblerait que la solution proposée soit fiable. A tester donc !...
Le code :
Sub Macro1()
Dim TA As Worksheet 'déclare la variable TA (Tableau)
Dim LI As Worksheet 'déclare la variable LI (LIste)
Dim EC As Worksheet 'déclare la variable EC (En Colonne)
Dim EL As Worksheet 'déclare la variable EL (En Ligne)
Dim EF As Worksheet 'déclare la variable EF (Enum Filtre)
Dim TVLI As Variant 'déclare la variable TVLI (Tableau des Valeurs LIste)
Dim TVEL As Variant 'déclare la variable TVEL (Tableau des Valeurs En Ligne)
Dim TVEC As Variant 'déclare la variable TVEC (Tableau des Valeurs En Colonne)
Dim TVEF As Variant 'déclare la variable TVEF (Tableau des Valeurs Enum Filtre)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim I As Integer, J As Integer, K As Integer, L As Integer, X As Integer 'déclare la variables I, J, K, L et X (incréments)
Dim TTB() As Range 'déclare la variable TTB (Tableau des TaBleaux)
Dim TEST As Boolean 'déclare la variable TEST
Dim E1 As String, E2 As String, E3 As String 'déclare les variables E1, E2 E3 (Entrée 1, Entrée 2, Entrée 3)
Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Set TA = Worksheets("Tableau") 'définit l'onglet TA
Set LI = Worksheets("liste_R1") 'définit l'onglet LI
Set EC = Worksheets("liste_R2") 'définit l'onglet EC
Set EL = Worksheets("liste_R3") 'définit l'onglet EL
Set EF = Worksheets("Enum_filtre") 'définit l'onglet EF
TVLI = LI.Range("A1").CurrentRegion 'définit le tableau TVLI
TVEL = EL.Range("A1").CurrentRegion 'définit le tableau TVEL
TVEC = EC.Range("A1").CurrentRegion 'définit le tableau TVEC
TVEF = EF.Range("A1").CurrentRegion 'définit le tableau TVEF
'*********************
'création des tableaux
'*********************
TA.Cells.Clear 'efface toutes les cellules de l'onglet TA
L = 1 'initialise la variable L
For I = 2 To UBound(TVLI, 1) 'boucle 1 : sur toutes les lignes I du tableau TVLI (en partant de la seconde)
'définit la cellule de destination DEST (A1 si A1 est vide , sinon la seconde cellule vide de la colonne A de l'onglet TA)
Set DEST = IIf(TA.Range("A1").Value = "", TA.Range("A1"), TA.Cells(Application.Rows.Count, "A").End(xlUp).Offset(2, 0))
DEST.Value = TVLI(I, 2) 'renvoie dans DEST la donnée ligne I colonne 2 de TVLI
For J = 2 To UBound(TVEC, 1) 'boucle 2 : sur toutes les lignes J du tableau TVEC (en partant de la seconde)
'renvoie dans DEST décalée de J-1 lignes vers le bas, la donnée ligne J colonne 2 de TVEC
DEST.Offset(J - 1, 0).Value = TVEC(J, 2)
Next J 'prochaine ligne de la boucle 2
For K = 2 To UBound(TVEL, 1) 'boucle 3 : sur toutes le lignes K du tableau TVEL (en partant de la seconde)
'renvoie dans DEST décalée de J-1 colonnes vers la droite, la donnée ligne K colonne 2 de TVEL
DEST.Offset(0, K - 1).Value = TVEL(K, 2)
Next K 'prochaine ligne de la boucle 3
With DEST.CurrentRegion 'prend en compte l'ensemble des cellules adjacentes à DEST
.Borders.ColorIndex = 1 'bordures couleur noire
.Interior.ColorIndex = 1 'remplissage couleur noire
End With 'fin de la prise en compte..
DEST.Resize(1, UBound(TVEL, 1)).Interior.ColorIndex = 15 'première ligne couleur grise
DEST.Resize(UBound(TVLI, 1), 1).Interior.ColorIndex = 15 'première colonne coleur grise
DEST.Interior.ColorIndex = xlNone 'enlève la couleur à DEST
ReDim Preserve TTB(L) 'redimensionne le tableau des tableaux TTB
Set TTB(L) = DEST.CurrentRegion 'définit le Lième tableau TTB(L) (correspont au nouveau tableau créé)
L = L + 1 'incrémente L
Next I 'prochaine ligne de la boucle 1
'***********************
'remplssage des tableaux
'***********************
For L = 1 To UBound(TTB) 'boucle 1 sur tous les tableaux du tableau des tableaux TTB
E1 = TTB(L)(1, 1) 'définit l'entrée E1 correspondant à la cellule ligne 1 colonne 1 du tableau TTB(L)
For J = 2 To TTB(L).Rows.Count 'boucle 2 : sur toutes les lignes J du tableau TTB(L) (en partant de la seconde)
E2 = TTB(L)(J, 1) 'définit l'entrée E2 correspondant à la cellule ligne J colonne 1 de TTB(L)
For K = 2 To TTB(L).Columns.Count 'boucle 3 : sur toutes le colonnes K du tableau TTB(L) (en partant de la seconde)
E3 = TTB(L)(1, K) 'définit l'entrée E3 correspondant à la cellule ligne 1 colonne K de TTB(L)
For X = 2 To UBound(TVEF, 1) 'boucle 4: sur toutes les ligne X du tableau TVEF (en partant de la seconde)
'si E1 correspond à la donnée ligne X colonne 2 de TVEF et E2 correspond à la donnée ligne X colonne 3 de TVEF
'et E3 correpond à la donnée ligne X colonne 4 de TVEF, enlève la couleur de la cellule ligne J colonne K de TTB(L)
'et sort de la boucle 4
If E1 = TVEF(X, 2) And E2 = TVEF(X, 3) And E3 = TVEF(X, 4) Then TTB(L)(J, K).Interior.ColorIndex = xlNone: Exit For
Next X 'prochaine ligne de la boucle 4
Next K 'prochaine colonne de la boucle 3
Next J 'prochaine ligne de la boucle 2
Next L 'prochain tableau de la boucle 1
End SubLe fichier :
Bonjour,
Bonjur ThauThème?
Une proposition à étudier avec Excel 2013+.
Cdlt.
Bonjour le fil, bonjour le forum,
@Jean-Éric
Ton TCD n'affiche pas le cap_prod_04 ?
Bonjour TauThème, bonjour Jean-Eric, bonjour le forum,
Merci à tous les deux pour vos réponses et votre temps consacré à mon souhait.
Le bouton créé par TauThème correspond parfaitement à ce qu'il me faut. J'ai essayé avec les différentes listes que j'avais (pour les R1, R2 et R3) et le résultat me parait correspondre à chaque fois à ce que j'attends.
Pour le TCD, le fait que j'importe des listes entraîne des pertes d'infos, ce qui génère des erreurs ensuite. Mais je garde tout ça sous le coude.
En tout cas, un grand merci à tous les deux pour votre réactivité et votre 'talent' à comprendre ma problématique
Cordialement,
Epohiel