INDEX.xlsx (10,5 Ko)
Bonjour
J’aimerai afficher tous les résultats dans une même cellule.
En p-j un petit exemple.
Merci par avance
Bonjour @Khalil_Boulbaroud,
Voici ce que je te propose avec une macro VBA.
Appuyer sur le bouton “Résultat” et la macro exécute la concaténation des cellule de la colonne “B” dans la colonne “E” et affiche les valeurs uniques de la colonne “A” dans la colonne “D”.
De plus les valeurs dans la colonne “A” sont triées par ordre alphabétique pour éviter les doublons dans la colonne “D”.
Voici le code:
Option Explicit
Sub Résultat()
Dim DerLig, i, j
Application.ScreenUpdating = False
ActiveWorkbook.Worksheets("EXEMPLE").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("EXEMPLE").Sort.SortFields.Add Key:=Range("A2:A65000") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("EXEMPLE").Sort
.SetRange Range("A1:B65000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
DerLig = [A2].End(xlDown).Row
j = -1
For i = 1 To DerLig
If [D2].Offset(j, 0) <> [A1].Offset(i, 0) Or j = -1 Then
j = j + 1
[D2].Offset(j, 0) = [A1].Offset(i, 0)
If [A1].Offset(i, 1) <> "" Then [D2].Offset(j, 1) = [A1].Offset(i, 1) Else [D2].Offset(i, 1) = ""
Else
If [A1].Offset(i, 1) <> "" Then [D2].Offset(j, 1) = IIf([D2].Offset(j, 1) = "", "", [D2].Offset(j, 1) & " & ") & _
[A1].Offset(i, 1)
End If
Next
End Sub
Et voici ton fichier en retour ICI==> Khalil_Boulbaroud V1.xlsm (18,4 Ko)
Cordialement.
2 « J'aime »
Bonjour MDO
Je suis séduit par la fonction, et je le serai encore plus si je pouvais l’intégrer à mon tableau. Je ne m’y connais pas en VBA et je ne sais réellement pas comment introduire ce code dans ma feuille.
Merci pour ton aide précieuse, ta patience et le temps accordé.
Par ailleurs, je remarque que dans le second tableau :
- la seconde ligne ne prend pas l’article saisi mais celui du premier tableau.
- une ligne se rajoute même sans article.
Merci par avance
Est-ce que les colonnes de ton vrai fichier son les mêmes que dans le fichier que tu nous a fourni, car cela a de l’importance.
Peux-tu me répondre sur ce point ?
Si c’est le cas, je t’expliquerai pour intégrer le code dans ton fichier, sinon il faudra modifier le code VBA et je t’expliquerai aussi.
Une autre solution, si ton fichier ne contient pas de données personnelles, alors joint le à ton message, quitte a mettre des données bidons pourvu que la structure ne change pas.
En ce qui concerne ta dernière remarque, j’y ais remédié.
@+
3- BESOINS CDE PREV HIVER.xlsx (766,8 Ko)
Merci infiniment pour ton aide et ton soutien. je t’ai mis en p-j le classeur avec les explications.
Bonne soirée
J’ai un peu révisé la feuille “ETQ”, en ajoutant un code VBA pour la colonne “A”, ce qui évite la formule matricielle gourmande en ressource.
Ça devrait être plus rapide.
Le code se trouve dans la feuille “nomenclature1”, pour le visualiser faire alt + F11
J’en ais profité aussi pour modifier les formules dans les colonnes “B, C, D, E, F” de la feuille “ETQ” pour une meilleur rapidité d’exécution.
Je te laisse tirer les formules des colonnes “G, H, I, J, K, L, M, N, Q”.
Par contre, je n’ais pas compris ce que je devais faire dans les colonnes “E & F”.
Peux-tu être plus précis dans ta demande avec un exemple de résultat manuel.
Ci joint ton fichier en retour ==> BESOINS CDE PREV HIVER V1.xlsm (903,2 Ko)
Dit moi ce que tu penses de la proposition que je te fais, je reprendrai demain en fonction de ta réponse.
Bonne soirée.
Cordialement.
1 « J'aime »
BESOINS CDE PREV HIVER.xlsm (998,7 Ko)
Bonjour MDO
Merci pour ton aide et ton assistance.
Je t’ai mis en p-j les réponses et remarques.
Bonne journée
Bonjour @Khalil_Boulbaroud,
Je regarde ça dans la journée.
Je vois que tu as éclairci le fichier, ce sera plus facile je pense.
4/DOIS JE GARDER LES DONNEES DE LA COLONNE AM DANS NOMENCALTURE1?
Non, j’ai oublié de supprimer ses données, c’était un essai pour compter les doublons, je supprimerai cette colonne.
@+
merci pour tout
Encore un petit détail sur la feuille ETQ dans la colonne A, on peut enlever la mise en forme (certaines cellules sont tramées).
Bonne journée
Bonjour @Khalil_Boulbaroud,
Déjà je n’ai pas réussi faire une macro inférieur à une durée d’une minute, du moins sur mon PC. 
et je me suis torturé les neurones.
Mais ça fonctionne, suffit d’être patient.
le nom de ses 2 feuilles ne doit pas être modifié, sinon il faudra modifier le code VBA.
Alors voici ma proposition, dans la feuille “ETQ”, j’ai mis 3 boutons, un GO qui exécute la macro comme tu le souhaitais dans les colonnes “E & F” en même temps elle exécute un tri sans doublons dans la colonne “A”.
Un bouton Efface Col A & Col E & Col F pour effacer les données si besoin dans les colonnes “A & E & F”, mais elles ne sont pas perdues, puisqu’avec GO elles seront réactualisées.
Un bouton Filtre quand il est désactivé dans la feuille “ETQ”, j’en ais mis un aussi dans la feuille “nomenclature1” Filtre 2.
Pour visualiser les codes faire alt + F11.
Fait moi savoir si cela te convient, mais de toute façon personnellement, je ne vois pas comment faire autrement.
Ci-joint ton fichier ICI==> BESOINS CDE PREV HIVER V2.xlsm (971,1 Ko)
Cordialement.
Bonsoir MDO
Infiniment merci de prime abord, pour ton aide précieuse.
Je jettes un coup d’œil et reviens vers toi.
Merci encore
C’est pas cool de ne pas avoir attendu au moins ma réponse sur ce forum, avant d’aller poser la même question sur un autre forum 
D’autant que tu t’ais fait houspiller par job75 .
Et que moi ça fait juste 2 jours que je travaille sur ton fichier, c’est un manque total de respect du travail que j’ai produit.
Sache que sur tous les forums, ceux qui aident les autres sont tous bénévoles et fier du travail qu’ils font pour aider, mais que nous sommes souvent sur plusieurs forums pour trouver des solutions et nous nous connaissons tous.
A bon entendeur, salut !
Bonsoir MDO,j’ai péché par impatience, mea culpa. Je ne connaissais pas votre forum jusqu’à tout récemment. Étant dans l’urgence, j’ai essayé de trouver une réponse un peu partout, et mes recherches m’ont menées à ce forum. Je suis d’autant plus honteux que je sais que vous êtes tous bénévoles et compétents. C’est la première fois que j’ai eu recours à cette pratique, plus par légèreté que par mauvaise intention, et je n’en mesure l’importance qu’en prenant conscience que je vous ai tous lésé dans vos efforts. On ne m’y reprendra plus! Je vous prie de m’excuser. Bonne soirée!
PS:Quant à l’incident avec Job75, je n’ai réellement rien fait pour. J’ai d’ailleurs procédé de la même manière avec toi. Je pensais aider en donnant un exemple simple dans un fichier léger…
Envoyé depuis Yahoo Mail pour Android
Bonjour @Khalil_Boulbaroud,
Voici les conseilles déjà donnés à d’autres, de la part du créateur de ce forum.
Et tu ne m’as pas dis si la solution qui fonctionne, même si le temps d’exécution est un peu long te convenait
Quand à job75, il est comme moi, nous aimons bien travailler sur un fichier d’égale structure à celui d’origine, sinon nous travaillons pour rien et sa remarque est juste, même si je ne t’en ais pas fait griefs ici.
Acceptées: À bientôt sur le forum.
Cdlt.
1 « J'aime »
Bonjour MDO
Désolé, j’étais en déplacement hier et te remercie pour ta compréhension. J’adhère pleinement aux conseils, et suis moi même porté sur les valeurs, mais là, en toute honnêteté, et même par mégarde, j’en ai manqué.
Concernant la solution proposée, au premier abord je la trouve pratique et efficace, et le temps d’exécution n’est pas un handicap majeur. Je vais travailler dessus aujourd’hui et reviens vers toi.
Bonne journée
Pour te montrer qu’il faut parfois du temps pour réaliser un travail de cette importance. 
Voici une nouvelle version, J’ai ajouté une feuille Tampon elle sert pour stocker les calcules provisoires, il ne faut absolument pas la supprimer et inutile de mettre quelque chose dedans puisqu’elle sera totalement effacée, mais elle est indispensable.
J’ai mis un bouton Sans Doublons Col A dans la feuille ETQ si tu ajoutes un nouveau CODE ART dans la feuille nomenclature1, alors tu appuis sur le bouton, ce qui ajoutera le nouveau code dans la feuille ETQ sans doublons. 10 secondes environ.
Ensuite dans la feuille ETQ j’ai mis un bouton Effacer ce qui efface les colonnes “E & F” de cette feuille.
Toujours dans la feuille ETQ il y a le bouton Concaténer Modèles & Tailles qui lui fait ce que tu as demandé en 7 secondes, un temps considérablement raccourcie par rapport à la version précédente.
Le fait d’appuyer sur ce bouton concatène les Modèles et les Tailles de la feuille nomenclature1 dans la feuille ETQ de plus cela agrandi les colonnes “E & F” en fonction du nombre des valeurs concaténées.
Voici le code VBA principal du Module 1.
Option Explicit
Dim shFrom As Worksheet
Dim shTo As Worksheet
Dim rngSource As Range, rng As Range
Dim dico As Object
Dim ref As Variant, itm As Variant, c As Variant
Dim i As Integer, j As Integer
Dim sComment As String
Dim DernLigne As Long
Sub Concatener_Modèles_Tailles()
'MODELES
Application.ScreenUpdating = False
Sheets("nomenclature1").Activate
DernLigne = Range("C" & Rows.Count).End(xlUp).Row
Range("C:C,J:J").Copy
Sheets("Tampon").Activate
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$B" & DernLigne).RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlYes
regroupeModeles
'TAILLES
Sheets("nomenclature1").Activate
Range("C:C,R:R").Copy
Sheets("Tampon").Activate
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$B" & DernLigne).RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlYes
regroupeTailles
'CENTRAGE TITRE
Range("A1,E1,F1").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Font.Bold = True
Range("A1").Select
End Sub
Sub regroupeModeles()
' init
Set shFrom = Worksheets("Tampon")
Set shTo = Worksheets("ETQ")
Set dico = CreateObject("scripting.dictionary")
Set rngSource = shFrom.Range("A1").CurrentRegion
' ajouter au dico
For Each rng In rngSource.Columns(1).Cells
ref = rng.Value
If Not dico.Exists(ref) Then
Set dico(ref) = New Collection
dico(ref).Add rng.Offset(0, 1).Value
Else
dico(ref).Add rng.Offset(0, 1).Value
End If
Next rng
' resultat
i = 1
For Each c In dico.Keys
j = 2
For Each itm In dico(c)
sComment = sComment & " & " & itm
Next itm
shTo.Cells(i, 1) = c
shTo.Cells(i, 5) = Right(sComment, Len(sComment) - 2)
sComment = ""
i = i + 1
Next
shTo.Columns(5).AutoFit
Sheets("Tampon").Activate
Columns("A:B").Delete
Sheets("ETQ").Activate
Range("a1").Select
End Sub
Sub regroupeTailles()
' init
Set shFrom = Worksheets("Tampon")
Set shTo = Worksheets("ETQ")
Set dico = CreateObject("scripting.dictionary")
Set rngSource = shFrom.Range("A1").CurrentRegion
' ajouter au dico
For Each rng In rngSource.Columns(1).Cells
ref = rng.Value
If Not dico.Exists(ref) Then
Set dico(ref) = New Collection
dico(ref).Add rng.Offset(0, 1).Value
Else
dico(ref).Add rng.Offset(0, 1).Value
End If
Next rng
' resultat
i = 1
For Each c In dico.Keys
j = 2
For Each itm In dico(c)
sComment = sComment & " & " & itm
Next itm
shTo.Cells(i, 1) = c
shTo.Cells(i, 6) = Right(sComment, Len(sComment) - 2)
sComment = ""
i = i + 1
Next
shTo.Columns(6).AutoFit
Sheets("Tampon").Activate
Columns("A:B").Delete
Range("a1").Select
Sheets("ETQ").Activate
Range("a1").Select
Application.ScreenUpdating = True
End Sub
Et voici ton fichier ICI==> BESOINS CDE PREV HIVER V3.xlsm (964,5 Ko)
Voila, voila ! 
J’espère que ta fidélité sur ce forum sera au rendez-vous pour tes prochaines questions.
Cordialement.
Avant même de voir le travail réalisé, ça me va droit au coeur et je te remercie infiniment pour l’attention et l’intérêt donné à mon fichier. je suis actuellement en déplacement avec des clients, mais dès que je rentre je te fais un retour. Très bonne soirée.!
Envoyé depuis Yahoo Mail pour Android
Hello @Khalil_Boulbaroud si ton problème est résolu n’oublie pas d’indiquer le message qui contient la réponse avec un petit 
sous le message stp!
1 « J'aime »