Intégration d'un concaténation

Version imprimable

1 pièce(s) jointe(s)

Bonjour

Je fais appel à votre champs de connaissances infinies du VBA ;). Cf:le tableau ci dessous:

Pièce jointe 488025

je dois réaliser une concaténation de données de la colonne2 dans la colonne 3 en fonction du nombre de lignes que comporte la case colonne 1 (exemple:
la case A (colonne1) comporte 4 lignes de données (colonne2) que je concatène dans la 1ere ligne de la colonne3.
Sachant que les plages à concaténer sont variables. J'ai écris la routine qui fonctionne mais qui me semble assez
lourde (je reproduis la concaténation en la répétant pour chaque ajout de ligne a concaténer, j'en ai fait 8 maximum, et j'ai
des cases colonnes2 de 25 lignes à concaténer. Comment puis-je itérer la concaténation sans avoir à l'ajouter explicitement
à chaque fois?
D'avance, merci

Code:

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
Sub concaten_1()
 
Dim i As Long
 
Range("A22") = "this is the end my friend"
 
 
Do
i = i + 1
 
If Cells(i, 1).Value <> "" And Cells(i, 1).Offset(1, 0).Value = "" And Cells(i, 1).Offset(2, 0).Value = "" And Cells(i, 1).Offset(3, 0).Value = "" And Cells(i, 1).Offset(4, 0).Value = "" And Cells(i, 1).Offset(5, 0).Value = "" And Cells(i, 1).Offset(6, 0).Value = "" And Cells(i, 1).Offset(7, 0).Value = "" And Cells(i, 1).Offset(8, 0).Value = "" Then
Cells(i, 3).FormulaR1C1 = "=CONCATENATE(RC[-1]&""   /   ""&R[1]C[-1]&""   /   ""&R[2]C[-1]&""   /   ""&R[3]C[-1]&""   /   ""&R[4]C[-1]&""   /   ""&R[5]C[-1]&""   /   ""&R[6]C[-1]&""   /   ""&R[7]C[-1])"
Else
If Cells(i, 1).Value <> "" And Cells(i, 1).Offset(1, 0).Value = "" And Cells(i, 1).Offset(2, 0).Value = "" And Cells(i, 1).Offset(3, 0).Value = "" And Cells(i, 1).Offset(4, 0).Value = "" And Cells(i, 1).Offset(5, 0).Value = "" And Cells(i, 1).Offset(6, 0).Value = "" And Cells(i, 1).Offset(7, 0).Value = "" And Cells(i, 1).Offset(8, 0).Value = "" Then
Cells(i, 3).FormulaR1C1 = "=CONCATENATE(RC[-1]&""   /   ""&R[1]C[-1]&""   /   ""&R[2]C[-1]&""   /   ""&R[3]C[-1]&""   /   ""&R[4]C[-1]&""   /   ""&R[5]C[-1]&""   /   ""&R[6]C[-1]&""   /   ""&R[7]C[-1])"
Else
If Cells(i, 1).Value <> "" And Cells(i, 1).Offset(1, 0).Value = "" And Cells(i, 1).Offset(2, 0).Value = "" And Cells(i, 1).Offset(3, 0).Value = "" And Cells(i, 1).Offset(4, 0).Value = "" And Cells(i, 1).Offset(5, 0).Value = "" And Cells(i, 1).Offset(6, 0).Value = "" Then
Cells(i, 3).FormulaR1C1 = "=CONCATENATE(RC[-1]&""   /   ""&R[1]C[-1]&""   /   ""&R[2]C[-1]&""   /   ""&R[3]C[-1]&""   /   ""&R[4]C[-1]&""   /   ""&R[5]C[-1]&""   /   ""&R[6]C[-1])"
Else
If Cells(i, 1).Value <> "" And Cells(i, 1).Offset(1, 0).Value = "" And Cells(i, 1).Offset(2, 0).Value = "" And Cells(i, 1).Offset(3, 0).Value = "" And Cells(i, 1).Offset(4, 0).Value = "" And Cells(i, 1).Offset(5, 0).Value = "" Then
Cells(i, 3).FormulaR1C1 = "=CONCATENATE(RC[-1]&""   /   ""&R[1]C[-1]&""   /   ""&R[2]C[-1]&""   /   ""&R[3]C[-1]&""   /   ""&R[4]C[-1]&""   /   ""&R[5]C[-1])"
Else
If Cells(i, 1).Value <> "" And Cells(i, 1).Offset(1, 0).Value = "" And Cells(i, 1).Offset(2, 0).Value = "" And Cells(i, 1).Offset(3, 0).Value = "" And Cells(i, 1).Offset(4, 0).Value = "" Then
Cells(i, 3).FormulaR1C1 = "=CONCATENATE(RC[-1]&""   /   ""&R[1]C[-1]&""   /   ""&R[2]C[-1]&""   /   ""&R[3]C[-1]&""   /   ""&R[4]C[-1])"
Else
If Cells(i, 1).Value <> "" And Cells(i, 1).Offset(1, 0).Value = "" And Cells(i, 1).Offset(2, 0).Value = "" And Cells(i, 1).Offset(3, 0).Value = "" Then
Cells(i, 3).FormulaR1C1 = "=CONCATENATE(RC[-1]&""   /   ""&R[1]C[-1]&""   /   ""&R[2]C[-1]&""   /   ""&R[3]C[-1])"
Else
If Cells(i, 1).Value <> "" And Cells(i, 1).Offset(1, 0).Value = "" And Cells(i, 1).Offset(2, 0).Value = "" Then
Cells(i, 3).FormulaR1C1 = "=CONCATENATE(RC[-1]&""   /   ""&R[1]C[-1]&""   /   ""&R[2]C[-1])"
Else
If Cells(i, 1).Value <> "" And Cells(i, 1).Offset(1, 0).Value = "" Then
Cells(i, 3).FormulaR1C1 = "=CONCATENATE(RC[-1]&""   /   ""&R[1]C[-1])"
Else
If Cells(i, 1).Value <> "" And Cells(i, 1).Offset(1, 0).Value <> "" Then Cells(i, 3).FormulaR1C1 = "=CONCATENATE(RC[-1])"
 
 
 
End If
End If
End If
End If
End If
End If
End If
End If
Loop Until Cells(i, 1).Value = "this is the end my friend"
 
 
End Sub

02/07/2019, 12h42
Menhir

Quelle est ta version d'Excel ?
02/07/2019, 12h51
volubiliss

Citation:

Envoyé par Menhir

Quelle est ta version d'Excel ?

Bonjour

Il s'agit d Excel 2016

Bonjour à vous,

Pour ma part, ce genre de formulation me donne le vertige.

Par VBA

Par hypothèse (comme l'on disait autrefois), la plage débute en A1.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Option Explicit
 
Sub essai()
 
Dim dernl As Long, i As Long, lastrow As Long, larow As Long
Dim laconcat As String
 
With Feuil1
        dernl = .Cells(.Rows.Count, 2).End(xlUp).Row
        larow = 1
        Do
                lastrow = Application.WorksheetFunction.Min(dernl, .Cells(larow, 1).End(xlDown).Row - 1)
                laconcat = ""
                For i = larow To lastrow
                        laconcat = laconcat & .Cells(i, 2).Value & " / "
                Next i
                laconcat = Left(laconcat, Len(laconcat) - 3)
                .Cells(larow, 3).Value = laconcat
                larow = lastrow + 1
        Loop While lastrow < dernl
End With
 
End Sub

Je n'ai pas testé, mais, à mon sens, la fonction Join aurait pu être affectée à une variable tableau afin de procéder à la concaténation.

D'autre part, je me méfie du "/" comme séparateur car ce symbole peut être un délimiteur de date.

02/07/2019, 14h22
volubiliss

Bonjour

En effet la formulation "bourrin" me donne moi même le vertige :) Merci cela fonctionne parfaitement.
02/07/2019, 14h33
MarcelG

volubiliss,

J'ai ôté de mon code la déclaration de la variable tableau, non utilisée.

Regarde également ma remarque quant au séparateur "/".

Bonne continuation.
02/07/2019, 15h08
Menhir

Une solution sans VBA :

Dans la première ligne vide après ton tableau, mets en colonne A une lettre (n'importe laquelle, c'est juste pour marquer la fin).

En D2, tu mets la formule :

Code:

=SI(A2="";"";LIGNE())

En C2, tu mets la formule :

Code:

=SI(A2="";"";JOINDRE.TEXTE(" / ";VRAI();DECALER(B2;0;0;MIN(D3:D100)-D2;1))

Tu copies C2:D2 vers le bas jusqu'à la fin de ton tableau.
Si tu ne veux pas casser les format (tes encadrements) fait un "copier + coller formule".

JOINDRE.TEXTE est une nouvelle fonction apparue avec 2016.
Pour plus d'info : https://support.office.com/fr-FR/art...3-0e8fc845691c

Bonjour,

c'est un code un peu lourd (sans vouloir te vexer) et pour concatener utilise & c'est plus simple

du coup voici un code qui fonctionne par rapport à ce que tu présentes et il n'y a pas de limite puisque cela t'inquiète

J'ai pris l'hypothèse que la cellule de départ est A2 et que les lignes de la colonne A ont des cellules vide si c'est la même valeur de cellule (Comme c'est dans la capture écran)
Code:

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 Sub Concat_Val() Dim Tablo(1 To 3) As String Dim Lign As Long Dim DerLign As Long 'Départ en ligne 2 Lign = 2 DerLign = [B2].End(xlDown).Row Tablo(1) = Cells(Lign, 1).Value Tablo(2) = Lign Tablo(3) = "'" & Cells(Lign, 2).Value For Lign = 3 To DerLign If Cells(Lign, 1) = "" Then Tablo(3) = Tablo(3) & " / " & Cells(Lign, 2).Value Else Cells(Tablo(2), 3) = Tablo(3) Tablo(1) = Cells(Lign, 1).Value Tablo(2) = Lign Tablo(3) = "'" & Cells(Lign, 2).Value End If Next Cells(Tablo(2), 3) = Tablo(3) End Sub
Tu nous dis si c'est bon ou pas

A bientôt

02/07/2019, 16h14
MarcelG

1 pièce(s) jointe(s)

Menhir et Igllobel :plusser:,

(Voir ci-dessus. J'avais pris une autre voie.)

Menhir,

Je n'aurais pas trouvé la formule (pas le courage!). Sauf erreur, la fonction DECALER est aussi utilisée pour l'affectation de nom à une plage dynamique.
Une réserve:
- Celle-ci comprend un "=" à l'intérieur. Je pense que tu as géré la condition après une première écriture, ce que je fais toujours (notamment avec Index et Equiv)
- Sur mon poste, à la 3ème occurrence de la colonne A, en colone C, j'ai la concaténation depuis la ligne 2

Pièce jointe 488083

J'aurais géré cette formulation par VBA en testant la 1ère colonne, et, pourquoi pas, un

Code:

.Value = .Value

Ceci afin de ne pas écrire la formule sur toute une plage. par purisme ;))

Igloobel

Juste rattacher les objets Range.
02/07/2019, 16h57
Menhir

Citation:

Envoyé par MarcelG

- Celle-ci comprend un "=" à l'intérieur.

Effectivement, il y avait un "=" avant JOINDRE.TEXTE qui n'avait aucune raison d'être là. :oops:
C'est corrigé. :ccool:

Citation:

- Sur mon poste, à la 3ème occurrence de la colonne A, en colone C, j'ai la concaténation depuis la ligne 2

Il faudrait voir quelle formule est en C10.
Normalement, les références relatives (entre autre le B2 dans DECALER) devrait éviter ce problème. :koi:

A moins que la troisième occurrence soit la dernière et qu'il n'y ait pas de numéro de ligne en D de la première ligne vide après le tableau.

1 pièce(s) jointe(s)

salut

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
    Dim P As Range, C As Range, Cm As Range
    DL = Cells(Rows.Count, 2).End(xlUp).Row
    Set P = Range("A2:A" & DL)
    For Each C In P
        If C.Value <> "" Then
            Set Cm = C: Cm.Offset(, 1) = Cm.Offset(, 1)
        Else
            Cm.Offset(, 1).NumberFormat = "@" ' uniquement si tu compte utiliser le "/" ou le "-" comme séparateur sinon tu peux supprimer cette ligne
            Cm.Offset(, 1) = Cm.Offset(, 1) & "/" & C.Offset(, 1): C.Offset(, 1) = ""
        End If
    Next
 
End Sub

Pièce jointe 488091

02/07/2019, 17h17
MarcelG

1 pièce(s) jointe(s)

Bonsoir Patrick,

Bien noté ton code.
Mais l'écriture s'effectue en colonne B au lieu de C.

Menhir,

As-tu constaté ma remarque, s'il te plaît,
Avec ta formulation, j'ai ce résultat

Pièce jointe 488121

Sans boucle :

Code:

1
2
3
4
5
6
7
8
9
Sub test()
    Dim Fin As Long
    Fin = Cells(Rows.Count, 2).End(xlUp)
    Cells(Fin + 1, 4).Value = Fin + 1
    Range("D2:D" & Fin).FormulaLocal = "=SI(A2="""";"""";LIGNE())"
    Range("C2:C" & Fin).FormulaLocal = "=SI(A2="""";"""";JOINDRE.TEXTE("" / "";VRAI();DECALER(B2;0;0;MIN(D3:D100)-D2;1))"
    Range("C2:C" & Fin).Value = Range("C2:C" & Fin).Value
    Range("D2:D" & Fin).ClearContents
End Sub

Citation:

Envoyé par MarcelG

As-tu constaté ma remarque, s'il te plaît,
Avec ta formulation, j'ai ce résultat

Essaye de mettre "16" en D16 (voir la dernière ligne de ma réponse #10).

Citation:

Essaye de mettre "16" en D16 (voir la dernière ligne de ma réponse #10).

Menhir,

Formulation
Le résultat est correct, en effet, si l'on écrit 16 en D16.

Code
Il manque la propriété Row. Pas grave.
Au demeurant, après avoir corrigé, une erreur 1004 (..définie par l'application ou l'objet...)
apparaît sur la ligne de code relative à la formulation (JOINDRE.TEXTE).
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub test2() Dim Fin As Long With Feuil1 Fin = .Cells(.Rows.Count, 2).End(xlUp).Row .Cells(Fin + 1, 4).Value = Fin + 1 .Range("D2:D" & Fin).FormulaLocal = "=SI(A2="""";"""";LIGNE())" .Range("C2:C" & Fin).FormulaLocal = "=SI(A2="""";"""";JOINDRE.TEXTE("" / "";VRAI();DECALER(B2;0;0;MIN(D3:D100)-D2;1))" With .Range("C2:C" & Fin) .Value = .Value End With .Range("D2:D" & Fin).ClearContents End With End Sub

re bonjour
ok marcel en "C"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
    Dim P As Range, C As Range, Cm As Range
    DL = Cells(Rows.Count, 2).End(xlUp).Row
    Set P = Range("B2:B" & DL)
    For Each C In P
        If C.Offset(, -1).Value <> "" Then
            Set Cm = C: Cm.Offset(, 2) = C
        Else
            Cm.Offset(, 2).NumberFormat = "@" ' uniquement si tu compte utiliser le "/" ou le "-" comme séparateur sinon tu peux supprimer cette ligne
            Cm.Offset(, 2) = Cm.Offset(, 2) & "/" & C
        End If
    Next
 
End Sub