✅ Afficher plusieurs résultats avec index [Excel 2007]


#1

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


#2

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.


#3

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é.


#4

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


#5

Re @Khalil_Boulbaroud,

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é.

@+


#6

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


#7

Re @Khalil_Boulbaroud,

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.


#8

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


#9

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.

@+


#10

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


#11

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. :cry: et je me suis torturé les neurones.
Mais ça fonctionne, suffit d’être patient.

:warning: 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.


#12

Bonsoir MDO
Infiniment merci de prime abord, pour ton aide précieuse.
Je jettes un coup d’œil et reviens vers toi.
Merci encore


#13

Re @Khalil_Boulbaroud,

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

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. :rage::rage::rage:

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 !


#14

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


#15

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.


#16

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


#17

Bonjour @Khalil_Boulbaroud,

Pas de soucis, à plus tard.

Bonne journée à toi également.

Cdlt.


#18

Re @Khalil_Boulbaroud,

Pour te montrer qu’il faut parfois du temps pour réaliser un travail de cette importance. :wink:

Voici une nouvelle version, :warning: 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 ! :blush:

J’espère que ta fidélité sur ce forum sera au rendez-vous pour tes prochaines questions. :wink:

Cordialement.


#19

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


#20

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 :white_check_mark: sous le message stp!