Discussion :

[bellamouna]

Bonjour,

Pouvez vous m'aider à faire un code sous VB pour regrouper les valeurs de plusieurs lignes dans une seule case. Merci d'avance...

Ex:

Villes
-----
Paris
Londres ---> Paris/ Londres / New York
New York

[jolop35]

Bonjour

Par formule
Si tes données sont en colonne A, en B1

=A1&"/ "&A2&"/ "&A3

Par macro

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub MACRO_TEST()
Dim r As Range
Dim c As Range
Dim s$
Set r = Range("A1:A" & [A65536].End(xlUp).Row)
For Each c In r
s = s & c & "/ "
Next
Cells(1, 2) = Left(s, Len(s) - 2)
End Sub

A+

J.L

[bellamouna]

Bonjour,
Je te remercie pour ta réponse mais je voudrai faire ça de façon plus generale, par ex de la premiere ligne à la derniere (pour une centaine de lignes ou plus) car je pourrai pas saisir ça pour toutes les lignes ... Merci

[bellamouna]

Ah j'avais pas vu le code ... ça devrait le faire avec ce que tu m'as donné merci bcp

[bellamouna]

Bonjour,

J'ai encore besoin d'un petit coup de main, en fait je voudrai regrouper les lignes mais éviter les répétitions en meme temps . merci !!

Ex:

Villes
-----
Paris
Paris
Londres ---> Paris/ Londres / New York
New York
New York

[jolop35]

Bonjour


Voici une nouvelle version

La colonne B doit être vide
Le résultat final est en C1

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub MACRO_TEST()
Dim r As Range
Dim c As Range
Dim s$
Set r = Range("A2:A" & [A65536].End(xlUp).Row)
r.AdvancedFilter xlFilterCopy, _
    CopyToRange:=Range("B1"), _
    Unique:=True
For Each c In Range("B1:B" & [B65536].End(xlUp).Row)
s = s & c & "/ "
Next
Cells(1, 3) = Left(s, Len(s) - 2)
End Sub

A+

J.L

[pgz]

Ou aussi en modifiant le premier code de jolop35

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub MACRO_TEST()
Dim r As Range
Dim c As Range
Dim s$
Set r = Range("A1:A" & [A65536].End(xlUp).Row)
s = "/"
For Each c In r
    If Not (s Like "*/" & c & "/*") Then s = s & c & "/"
Next
Cells(1, 2) = Mid(s, 2, Len(s) - 2)
End Sub

je n'ai pas testé.

PGZ

[bellamouna]

Merci bcp pour votre aide !!

[bellamouna]

Bonjour,

J'ai toujours un problème quand je fais le tri ... j'ai une ligne qui se répéte

Résulat:
--------
A B E : colonnes

paris paris ------> paris/ paris/ lyon/ new york/ amterdam/ londres
paris paris
paris lyon
paris new york
paris amterdam
paris londres
lyon
lyon
lyon
new york
amterdam
londres


Code:
-----

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
Sub MACRO_TEST()
 
Dim r As Range
Dim c As Range
Dim s$
 
ligne = 1
ligne2 = 12
 
Workbooks("Annual Review test.xls").Worksheets("Feuil1").Activate
Set r = Range("A" & ligne & ":A" & ligne2)
    r.AdvancedFilter xlFilterCopy, _
    CopyToRange:=Range("B" & ligne), _
    Unique:=True
 
'On calcule le num de la derniere ligne de la colonne B après le tri
If (Worksheets("Feuil1").Range("B" & ligne + 1) <> Null) Then
   ligne3 = ligne + 1
Else
   ligne3 = Worksheets("Feuil1").Range("B" & ligne + 1).End(xlDown).Row + 1
End If
 
 
For Each P In Range("B" & ligne & ":B" & ligne3 - 1)
   s = s & P & "/ "
Next
 
Cells(1, 5) = Left(s, Len(s) - 2)
 
End Sub

[jolop35]

Bonsoir


Une toute autre méthode:

Résultat après exécution: en B1:F1
paris,lyon,new,amterdam,londres

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
Sub MACRO_TESTsd()
Dim a, aWS As Worksheet
Dim r As Range, txt As String
Set aWS = _
    ActiveSheet
    With CreateObject("Scripting.Dictionary")
    For Each r In Intersect(aWS.Columns("A"), _
    aWS.UsedRange.Rows)
        If Not .exists(r.Value) Then
            .Add r.Value, Nothing
        Else
            txt = txt & "," & r.Address(0, 0)
        End If
    Next
    End With
If Len(txt) Then aWS.Range(Mid(txt, 2)).Delete Shift:=xlUp
a = _
    aWS.Range("A1:A" & [A65536].End(xlUp).Row).Value
aWS.Range(Cells(1, 2), Cells(1, UBound(a) + 1)) = _
    Application.Transpose(a)
End Sub

J.L

[bellamouna]

Bonjour,

Le code que tu m'as donné ne donne pas le résultat que t'as mis mais me donne ça :

lyon -----> lyon new york amterdam londres
new york
amterdam
londres

chaque ligne dans une colonne différente.

[jolop35]

Bonsoir



En reprenant de l'évoqué précédemment

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
Sub MACRO_TESTsde()
Dim s$, aWS As Worksheet
Dim r As Range, txt$, L&
Set aWS = _
    ActiveSheet
    With CreateObject("Scripting.Dictionary")
    For Each r In Intersect(aWS.Columns("A"), _
    aWS.UsedRange.Rows)
        If Not .exists(r.Value) Then
            .Add r.Value, Nothing
        Else
            txt = txt & "," & r.Address(0, 0)
        End If
    Next
    End With
If Len(txt) Then aWS.Range(Mid(txt, 2)).Delete Shift:=xlUp
For L = 1 To aWS.UsedRange.Rows.Count
s = s & Cells(L, 1) & "/"
Next
Range("B1") = Mid(s, 1, Len(s) - 1)
End Sub

@+

J.L

[bellamouna]

Bonjour,

Merci bcp bcp pour votre aide , et je voudrai juste demander un dernier petit coup de pouce .... Je voudrai savoir comment faire pour mettre les lignes triées dans une autre colonne ("B" par ex) que dans la colonne "A" la colonne d'origine pour qu'elle reste intact.

Merci d'avance...

[bellamouna]

Bonjour,

J'arrive pas à modeler le code que vous m'avez donné avec ce que je veux faire , car je l'ai pas très bien compris

Est ce que quelqu'un pourrai m'aider ...
Je voudrai repérer pour chaque contrat les villes qu'il contient, les trier et les mettre dans une colonne a part .


Num contrat Villes Résultat dans une autre feuille
------------ ------ ------------------------------
1 paris feuill1-> paris/ londres/new york
1 paris
1
1 londres
1 new york
2 moscou feuill2->moscou/madrid
2 madrid



Merci d'avance...