Concatener plusieurs colonne avec x critères

**munity** · 06/12/2018, 12h34

salut le phorum

je me bats depuis ce matin pour réussir à concatener plusieurs colonnes (10) en fonction de critères
je ne veux pas de concatenation des éléments suivants
Nom : exclu.jpg
Affichages : 995
Taille : 14,5 Ko

Nom : exclu.jpg
Affichages : 995
Taille : 14,5 Ko

uniquement ceux issus de cette liste
Nom : a concatener.jpg
Affichages : 980
Taille : 20,2 Ko

et voici le résultat souhaité
Nom : EXEMPLE RESULTAT SOUHATE.jpg
Affichages : 1057
Taille : 47,9 Ko

y a-t-il un moyen simple d'obtenir ce résultat ?

merci d'avance

david

**Trystan441** · 06/12/2018, 13h02

Bonjour David,

Je sens un peu de frustration dans tes paroles !

Je viens de chercher une solution et j'en ai trouvé un mais elle est relativement lourde :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=Concatener(SI(AY2=RECHERCHEV(AY2;A1:A30;1;FAUX);AY2;"");SI(AZ2=RECHERCHEV(...

Et ceci avec toutes les cellules que tu souhaites concaténer.

Comme je te le disais c'est relativement lourd donc si quelqu'un peut te donner une meilleure solution, je suis moi aussi preneur !

Bonne journée à toi,

**MarcelG** · 06/12/2018, 13h06

Bonjour,

A priori, je ne verrais que VBA.
Une piste en 2 étapes:
1 - Créer une fonction booléenne Exclu reprenant les codes à exclure. soit regroupés en un tableau Array, soit concaténés en une chaîne de caractères.
2 - Pour la concaténation, boucler sur les cellules avec la condition

Exclu(lacellule.Value) = False

.

Variante si les codes à exclure figurent sur 1 feuille.
La recherche du code à exclure n'est rien.

**munity** · 06/12/2018, 14h07

merci à tous les deux pour vos propositions
effectivement, je pense que VBA serait plus judicieux
par contre marcel pourrais tu m'aider à développer la macro
j'arrive à déchiffrer les macros (si pas trop complexes...) mais développer comme indiquer ci dessus
j'avoue que je sèche un peu....

on part du principe que dans un onglet je ne mets que les valeurs a concatener
dans un second les valeurs à exclure
et dans l'onglet principal, colonne BI j'obtiens mon résultat final

j'espère que je ne t'en demande pas trop... je voudrais pas abuser

merci beaucoup

david

**munity** · 06/12/2018, 14h09

Envoyé par Trystan441

merci pour ta proposition mais le souci c'est que les fonctions imbriquées SI sont limitées à 7 or j'ai 10 colonnes à tester....

**Trystan441** · 06/12/2018, 14h31

Munity,

Si jamais tu souhaites éviter VBA, tu peux aussi utiliser la méthode suivante : (composée de SIERREUR)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=CONCATENER(SIERREUR(RECHERCHEV(A35;A27:A33;1;FAUX);"");SIERREUR(RECHERCHEV(etc.

En cas de rajout de critère d'exclusion, passe ta plage en tableau pour que ta zone de recherche devienne dynamique.

Trystan

**munity** · 06/12/2018, 14h44

merci de ta réponse
le VBA me convient aussi

**MarcelG** · 06/12/2018, 14h52

Salut,

Une précision, s'il te plaît.
Les codes à exclure sont-ils reportés dans une feuille de travail, ou peut-on les gérer directement dans VBA?
La 1ère hypothèse serait la plus simple.

**munity** · 06/12/2018, 15h03

l'idéal serait de pouvoir etoffer cette liste au besoin tout comme la liste des codes à concatener
donc oui un feuille pour les exclusions et une autre pour les concatenations
l'utilisateur final n'y connait rien en VBA donc il faut qu'il puisse modifier en fonction de ses besoins les critères
je ne serais pas toujours là pour modifier la macro....

**MarcelG** · 06/12/2018, 15h36

Coucou,

Dans la 1ère hypothèse (liste de codes à exclure sur une feuille séparée de celle où s'effectue la cobncaténation.

Dans le code suivant:
2 feuilles "CONCAT" et "UTILITAIRES"

Dans la feuille "UTILITAIRES"
Champ nommé "liste_exclu" comprenant tous les codes à exclure

Dans la feuille "CONCAT"
Les codes à concaténer se situent de la colonne A à la colonne F
Concaténation en colonne G

CODE A ADAPTER
(au niveau des adresses, des noms de feuilles)

Pour te guider, j'ai intégré quelques commentaires.
(Je le fais rarement, mais bon...)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Option Explicit
 
Public Function exclu(lecode As String) As Boolean
 
Dim t As Range
 
'Recherche du code dans le champ nommé liste_excu
Set t = Worksheets("UTILITAIRES").Range("liste_exclu").Find(lecode, LookIn:=xlValues, lookat:=xlWhole)
'Si le code n'est pas rien, - i.e. est trouvé -, alors il est exclu
exclu = (Not t Is Nothing)
'Libération de la variable
Set t = Nothing
 
End Function
 
Public Sub laconcat()
 
Dim laplage As Range
Dim c As Range, cod As Range
Dim lachaine As String
 
With Worksheets("CONCAT")
        'Définitiondu champ vertical des cellules à concaténer
        '1ère cellule = G2, dernière = la dernière cellule en partant du bas de la feuille
        Set laplage = .Range("G2:G" & .Cells(.Rows.Count, 1).End(xlUp).Row)
        For Each c In laplage
                'Initialisation de la chaine de caractères de concaténation à vide
                lachaine = ""
                'Booucle sur les codes de la 1ère (A) à la 6ème colonne (F)
                'sur la ligne de la cellule de concaténation
                For Each cod In .Range(.Cells(c.Row, 1), .Cells(c.Row, 6))
                        'Test 1 : code informé, Test 2 : code non exclu
                        If Len(cod) > 0 And exclu(cod.Value) = False Then
                                lachaine = lachaine & cod.Value & " "
                        End If
                Next cod
                'Suppression du dernier blanc
                lachaine = RTrim(lachaine)
                'concaténation sur la cellule
                c.Value = lachaine
        Next c
        'Libération de la variable
        Set laplage = Nothing
End With

**munity** · 06/12/2018, 15h57

merci Marcel
je mets en application et te tiens informé
un grand merci pour la macro

**munity** · 06/12/2018, 16h30

un grand merci MarcelG
cela fonctionne parfaitement
ci dessous le code quelque peu modifié (j'ai pas du faire grand chose pour l'adapter

)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
 
 
Option Explicit
 
Public Function exclu(lecode As String) As Boolean
 
Dim t As Range
 
'Recherche du code dans le champ nommé liste_excu
Set t = Worksheets("EXCLUSIONS").Range("liste_exclu").Find(lecode, LookIn:=xlValues)
'Si le code n'est pas rien, - i.e. est trouvé -, alors il est exclu
exclu = (Not t Is Nothing)
'Libération de la variable
Set t = Nothing
 
End Function
 
Public Sub laconcat()
 
Dim laplage As Range
Dim c As Range, cod As Range
Dim lachaine As String
 
With Worksheets("FICHIER TEST TRANSFORME")
        'Définitiondu champ vertical des cellules à concaténer
        '1ère cellule = G2, dernière = la dernière cellule en partant du bas de la feuille
        Set laplage = .Range("BI2:BI" & .Cells(.Rows.Count, 1).End(xlUp).Row)
        For Each c In laplage
                'Initialisation de la chaine de caractères de concaténation à vide
                lachaine = ""
                'Booucle sur les codes de la 1ère (AY) à la 6ème colonne (BH)
                'sur la ligne de la cellule de concaténation
                For Each cod In .Range(.Cells(c.Row, 51), .Cells(c.Row, 60))
                        'Test 1 : code informé, Test 2 : code non exclu
                        If Len(cod) > 0 And exclu(cod.Value) = False Then
                                lachaine = lachaine & cod.Value & " "
                        End If
                Next cod
                'Suppression du dernier blanc
                lachaine = RTrim(lachaine)
                'concaténation sur la cellule
                c.Value = lachaine
        Next c
        'Libération de la variable
        Set laplage = Nothing
End With
End Sub

et j'ai utilisé la fonction décaler pour avoir la liste_exclu en dynamique

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=DECALER(EXCLUSIONS!$A$2;;;NBVAL(EXCLUSIONS!$A:$A)-1)

encore un grand merci

première étape terminé
je continue en espérant pouvoir me débrouiller

**MarcelG** · 06/12/2018, 16h50

Coucou,

Bravo pour le nom dynamique.

Des questions sur le code?
Essaie de comprendre mot à mot, ligne par ligne.
Cette intégration sera un investissement pour tes développements futurs.

Si ta demande est satisfaite, alors tu peux placer cette discussion en mode 'Résolue"

**munity** · 06/12/2018, 17h09

pour être honnete, ce sont des instructions que je connais
mais je ne serais jamais parvenu à ce résultat ne sachant pas dans quel sens prendre le problème

c'est le défaut d'un autodidacte en VBA

sinon le code une fois lu et relu est parfaitement clair
merci pour tes commentaires qui m'ont bien aidé

et oui cela sera un plus pour mes développements futurs, c'est sur

david

**munity** · 10/12/2018, 18h06

Salut MarcelG
Je me permets de reactiver ce post
En effet j aimerai savoir comment je peux faire pour classer par ordre alphabetique le resultat de la cellule
Merci pour ton aide ou piste
David

**MarcelG** · 11/12/2018, 09h52

Bonjour munity, Bonjour le Forum,

Tu utilises la méthode sort décrite ici.

Je te laisse regarder les changements. Comme précédemment, tu adaptes.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Option Explicit
 
Public Function exclu(lecode As String) As Boolean
 
Dim t As Range
 
'Recherche du code dans le champ nommé liste_excu
Set t = Worksheets("UTILITAIRES").Range("liste_exclu").Find(lecode, LookIn:=xlValues, lookat:=xlWhole)
'Si le code n'est pas rien, - i.e. est trouvé -, alors il est exclu
exclu = (Not t Is Nothing)
'Libération de la variable
Set t = Nothing
 
End Function
 
Public Sub laconcat()
 
Dim dernl As Integer
Dim laplage As Range
Dim c As Range, cod As Range
Dim lachaine As String
 
With Worksheets("CONCAT")
        dernl = .Cells(.Rows.Count, 1).End(xlUp).Row
        'Définition du champ vertical des cellules à concaténer
        '1ère cellule = G2, dernière = la dernière cellule en partant du bas de la feuille
        Set laplage = .Range("G2:G" & dernl)
        For Each c In laplage
                'Initialisation de la chaine de caractères de concaténation à vide
                lachaine = ""
                'Booucle sur les codes de la 1ère (A) à la 6ème colonne (F)
                'sur la ligne de la cellule de concaténation
                For Each cod In .Range(.Cells(c.Row, 1), .Cells(c.Row, 6))
                        'Test 1 : code informé, Test 2 : code non exclu
                        If Len(cod) > 0 And exclu(cod.Value) = False Then
                                lachaine = lachaine & cod.Value & " "
                        End If
                Next cod
                'Suppression du dernier blanc
                lachaine = RTrim(lachaine)
                'concaténation sur la cellule
                c.Value = lachaine
        Next c
 
        'Tri par ordre croissant
        With .Sort
                .SortFields.Clear
                .SortFields.Add Key:=laplage, _
                        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange Worksheets("CONCAT").Range("A2:G" & dernl)
                .Header = xlGuess
                .Apply
        End With
 
        'Libération de la variable
        Set laplage = Nothing
 
End With
 
End Sub

**munity** · 11/12/2018, 11h50

merci MarcelG

ce n'est pas tout à fait ca que je souhaite
je veux trier dans une cellule et non une plage de cellule
par contre j'ai trouvé en cherchant un peu, suite à ta méthode proposé, une fonction qui tri dans une cellule
ci dessous mon code modifié

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
 
 
Option Explicit
 
Public Function exclu(lecode As String) As Boolean
 
Dim t As Range
 
'Recherche du code dans le champ nommé liste_excu
Set t = Worksheets("EXCLUSIONS").Range("liste_exclu").Find(lecode, LookIn:=xlValues)
'Si le code n'est pas rien, - i.e. est trouvé -, alors il est exclu
exclu = (Not t Is Nothing)
'Libération de la variable
Set t = Nothing
 
End Function
 
Public Sub laconcat()
 
Dim laplage As Range
Dim c As Range, cod As Range
Dim lachaine As String
Dim dernl As Integer
Dim compteur As Long
 
With Worksheets("FICHIER TEST TRANSFORME")
        dernl = .Cells(.Rows.Count, 1).End(xlUp).Row
        'Définition du champ vertical des cellules à concaténer
        '1ère cellule = G2, dernière = la dernière cellule en partant du bas de la feuille
        Set laplage = .Range("BI2:BI" & dernl)
        For Each c In laplage
                'Initialisation de la chaine de caractères de concaténation à vide
                lachaine = ""
                compteur = 1
                'Booucle sur les codes de la 1ère (AY) à la 6ème colonne (BH)
                'sur la ligne de la cellule de concaténation
                For Each cod In .Range(.Cells(c.Row, 51), .Cells(c.Row, 60))
                If compteur = 1 Then
                        'Test 1 : code informé, Test 2 : code non exclu
                        If Len(cod) > 0 And exclu(cod.Value) = False Then
                            lachaine = lachaine & cod.Value
                        End If
                Else
                        If Len(cod) > 0 And exclu(cod.Value) = False Then
                            lachaine = lachaine & ", " & cod.Value
                        End If
                End If
                compteur = compteur + 1
                Next cod
                'Suppression du dernier blanc
                lachaine = TriCellule(RTrim(lachaine))
                'concaténation sur la cellule
                'c.Value = (lachaine)
                c.Value = Application.WorksheetFunction.Clean(Application.WorksheetFunction.Trim(UCase(Replace(Replace(Replace(lachaine, Chr(9), ""), Chr(10), ""), Chr(160), ""))))
        Next c
 
        'Libération de la variable
        Set laplage = Nothing
End With
End Sub
Public Function TriCellule(c) As String
Dim Temp
Dim Sauv As String
Dim i As Long, j As Long
 
    If IsEmpty(c) Then Exit Function
    Temp = Split(c, ",")
    '----  tri
    For i = LBound(Temp) To UBound(Temp)
        For j = i To UBound(Temp)
            If Temp(j) < Temp(i) Then
                Sauv = Temp(j)
                Temp(j) = Temp(i)
                Temp(i) = Sauv
            End If
        Next j
    Next i
 
    TriCellule = Join(Temp, " ")
 
End Function

**MarcelG** · 11/12/2018, 12h10

Salut,

Ah! D'accord.

Il ne te reste plus qu'à adapter.

1 - Modification

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

c.Value = TriCellule(lachaine)

2 - La fonction

Ici, le séparateur est un espace.
Pour la méthode Split, tu peux consulter ce tutoriel à propos des chaines de caractères.
D'autre part, mieux vaut préciser le type d'argument qu'attend la fonction.
Enfin, même s'il est tacite, je déclare, dans les cas extrêmes, les variables en type Variant
Ce qui donne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Public Function TriCellule(c As String) As String
 
Dim Temp As Variant
Dim Sauv As String
Dim i As Byte, j As Byte
 
    If IsEmpty(c) Then Exit Function
    Temp = Split(c, " ")
    '----  tri
    For i = LBound(Temp) To UBound(Temp)
        For j = i To UBound(Temp)
            If Temp(j) < Temp(i) Then
                Sauv = Temp(j)
                Temp(j) = Temp(i)
                Temp(i) = Sauv
            End If
        Next j
    Next i
 
    TriCellule = Join(Temp, " ")
 
End Function

**munity** · 11/12/2018, 12h23

merci de tes précieux conseils
j'ai un peu modifié le code comme indiqué

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
 
'concaténation sur la cellule + tri Alphabétique
    lachaine = TriCellule(lachaine)
'Suppression espaces ou autres
    c.Value = Application.WorksheetFunction.Clean(Application.WorksheetFunction.Trim(UCase(Replace(Replace(Replace(lachaine, Chr(9), ""), Chr(10), ""), Chr(160), ""))))

j'ai du changer en long versus byte car dépassement de capacité...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

Public Function TriCellule(c) As String
Dim Temp As Variant
Dim Sauv As String
Dim i As Long, j As Long
    
    If IsEmpty(c) Then Exit Function
    Temp = Split(c, ", ")
    '----  tri
    For i = LBound(Temp) To UBound(Temp)
        For j = i To UBound(Temp)
            If Temp(j) < Temp(i) Then
                Sauv = Temp(j)
                Temp(j) = Temp(i)
                Temp(i) = Sauv
            End If
        Next j
    Next i
    
    TriCellule = Join(Temp, " ")
    
End Function

mais sinon tout est ok