plusieurs cellule dans une cellue

[baudax]

Bonjour,

j'ai un tableau :

Nom 1 a
Nom 1 b
Nom 1 c
Nom 1 d
Nom 2 x
Nom 2 y
Nom 2 z
Nom 3 t
Nom 4 u


j'aimerais avoir un tableau sous la forme

Nom 1 a - b - c - d
Nom 2 x - y - z
Nom 3 t
Nom 4 u


j'ai essayé plusieurs choses mais rien ne donne le résultat escompté.

merci à vous

ludo

 

[Softmama]

Re : plusieurs cellule dans une cellue

Bonjour,

ceci :

Private Sub CommandButton1_Click()
Dim c As Range, d As Range
Set c = Range("A1")
Do While c <> ""
  If Not IsError(Application.Match(c, Range("D1:D1000"), 0)) Then
    Set d = Range("D1:D1000").Find(what:=c, LookIn:=xlValues, lookat:=xlWhole).Offset(, 1)
    d = d & " - " & c.Offset(, 1)
  Else
    Set d = Range("D1000").End(xlUp).Offset(1)
    d = c
    d.Offset(, 1) = c.Offset(, 1)
  End If
  Set c = c.Offset(1)
Loop
End Sub

cf. fichier joint.

 

[mapomme]

Re : plusieurs cellule dans une cellue

Bonjour,

Une tentative avec une colonne auxilliaire (colonne C) qu'on peut masquer et deux formules matricielles.
Attention ! La formule en C1 ('=B1') diffère des autres formules de la colonne C.

En C2 (à tirer vers le bas)

:=SI(A2<>A1;B2;C1 & "-" & B2)

En D1 (à tirer vers le bas):

=SIERREUR(INDEX($A$1:$A$1999;PETITE.VALEUR(SI($A$1:$A$1998<>$A$2:$A$1999;LIGNE($A$1:$A$1998);"");LIGNE()));"")

En E1 (à tirer vers le bas):

=SIERREUR(INDEX($C$1:$C$1999;PETITE.VALEUR(SI($A$1:$A$1998<>$A$2:$A$1999;LIGNE($A$1:$A$1998);"");LIGNE()));"")

Les formules en colonnes Cet D sont des formules matricielles.

Formule matricielle: Elle doit être validée par la combinaison des touches Ctrl+Maj+Entrée au lieu de la seule touche Entrée comme une formule classique.
Si la validation matricielle est correcte, alors Excel entoure la formule d'accolades {=.......}.
Chaque fois que cette formule sera modifiée, la validation devra se faire par Ctrl+Maj+Entrée. Les accolades apparaissent à la validation et ne doivent pas être saisies au clavier.

NB: Ceci ne fonctionne que si les données sources sont triées selon les noms.

 

[MichD]

Re : plusieurs cellule dans une cellue

Bonjour,

Une autre alternative :


Sub test()
Dim C As Range, A As Integer, NbLig As Long
Application.ScreenUpdating = False
Set C = Range("B1")
A = 1
Do While C.Value <> ""
If C.Offset(1).Value = C.Value Then
A = A + 1
C.Offset(, A) = C.Offset(1, 1).Value
C.Offset(1).EntireRow.Delete
NbLig = NbLig + 1
Else
Set C = C.Offset(1)
A = 1
End If
Loop
Application.ScreenUpdating = True
End Sub

 

[R@chid]

Re : plusieurs cellule dans une cellue

Bonsoir @ tous,
Je voie que les donnees de notre ami sont triees sur la colonne des noms, alors on aura besoin de formule matricielle juste pour les chercher les noms sans doublons.

En F2 :

=SI(LIGNES($2:2)<=SOMME(1/NB.SI(Col_Noms;Col_Noms));INDEX(Col_Noms;MIN(SI(NB.SI(F$1:F1;Col_Noms)=0;LIGNE(INDIRECT("1:"&LIGNES(Col_Noms))))));"")

@ Valider par Ctrl+Maj+Entree
@ Tirer ves le Bas.

En G2 :

=SI(ET($F2<>"";COLONNES($G:G)<=NB.SI(Col_Noms;$F2));INDEX(Col_Valeurs;EQUIV($F2;Col_Noms;0)+COLONNES($G:G)-1);"")

@ Valider par Simple Entree
@ Tirer vers la Droite et vers le Bas.

Voir PJ.
Amicalement

Edit : on peut faire aussi simple en G2 :

=SI(ET($F2<>"";COLONNES($G:G)<=NB.SI(Col_Noms;$F2));DECALER($B$1;EQUIV($F2;Col_Noms;0)+COLONNES($G:G)-1;);"")

@ Valider par Simple Entree
@ Tirer vers la Droite et vers le Bas

 

[laetitia90]

Re : plusieurs cellule dans une cellue

bonjour tous 🙂

une autre facon de l'ecrire !!

Sub es()
 Dim m As Object, c As Range
 Set m = CreateObject("Scripting.Dictionary")
 For Each c In Range("a1", Cells(Rows.Count, "a").End(xlUp))
 m(c.Value) = IIf(Not m.exists(c.Value), c.Offset(, 1) _
 .Value, m(c.Value) & " - " & c.Offset(, 1).Value)
 Next c
 [c2].Resize(m.Count, 1) = Application.Transpose(m.keys)
 [D2].Resize(m.Count, 1) = Application.Transpose(m.items)
End Sub

 

[baudax]

Re : plusieurs cellule dans une cellue

Merci beaucoup pour vos réponses je vais essayé de ce pas. J'espere m'en sortir 😀

 

[BOISGONTIER]

Re : plusieurs cellule dans une cellue

Bonjour,

Regroupement

http://boisgontierjacques.free.fr/fichiers/Cellules/Regroupe.xls

JB