[RESOLU] Copier plusieurs cellules de texte en une seule

[damsdm]

Bonjour et merci d'avance pour votre aide.

Voilà mon souci : j'ai un tableau avec plusieurs lignes.
Chaque ligne représente une entreprise qui a eu un jeune dans une formation par année.
Le souci est qu'une entreprise a pu prendre un jeune en 2007 et en 2009 (cela fait 2 lignes différentes).

Mon objectif serait d'avoir une seule ligne par entreprise et copier dans cette ligne là les informations de la colonne.

Ex : Col 1 (2007) | Col 2 (2008) | Col 3 (2009) | Entreprise
//////| bp chateau | ///////////// | ///////////// | Entse1
//////| //////////// | cap poteau | ///////////// | Entse1
//////| bp chateau | ///////////// | cap cargo / | Entse1
//////| //////////// | bp cargo//// | ///////////// | Entse1

et cela devrait donner :

Ex : //Col 1 (2007) /////////| /// Col 2 (2008) /// | ///// Col 3 (2009) | Entreprise
//////| bp chateau / bp chateau | cap poteau / bp cargo | cap cargo | Entse1

J'ai mis le tableau en pièce jointe pour une meilleure visualisation

Merci beaucoup pour votre aide car j'ai un fichier avec beaucoup de ligne et j'ai testé la méthode manuelle ce qui prendre beaucoup de temps, les formules "concaténer" mais cela oblige à créer une nouvelle ligne à chaque fois et de recréer la formule... bref je ne trouve pas de solution....

 

[LAURENCE27]

Re : Copier plusieurs cellules de texte en une seule

Bonjour,
t'es t il possible de mettre une ligne en exemple, car je ne comprends pas ce que tu veux faire exactement ?????

 

[damsdm]

Re : Copier plusieurs cellules de texte en une seule

Bonjour,
t'es t il possible de mettre une ligne en exemple, car je ne comprends pas ce que tu veux faire exactement ?????

Dans l'exemple que j'ai noté il y a plusieurs lignes pour l'entreprise nommé "entse1".

Je souhaiterais qu'il n'y ait qu'une seule ligne reprenant les informations par année.
Dans l'ex j'ai mis ce que je souhaiterais comme résultat : la colonne 1 avait 4 ligne et contenait 2 fois le "bp chateau" et le résultat donne pour la colonne 1 le texte "bp chateau" repris 2 fois dans la même cellule.

Je ne sais pas si cela est plus clair lol. Si ce n'est pas le cas n'hésite pas à me le dire que j'explicite mieux.

 

[job75]

Re : Copier plusieurs cellules de texte en une seule

Bonjour damsdm, bienvenue sur XLD, bonjour Laurence27,

Voyez le fichier joint et cette macro (Alt+F11) :

Sub Regrouper()
Dim tablo, ub&, d As Object, i&, txt$, t$, j As Byte, k&
tablo = Range("B2", Range("H" & Rows.Count).End(xlUp))
ub = UBound(tablo)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To ub
  txt = tablo(i, 7)
  If txt <> "" And Not d.exists(txt) Then
    t = txt
    For j = 1 To 6
      For k = 1 To ub
        If tablo(k, 7) = txt Then
          If tablo(k, j) <> "" Then t = t & Chr(1) & tablo(k, j)
        End If
      Next
    Next
    d(txt) = t
  End If
Next
'---restitution---
With Sheets("Regroupe")
  .Rows("2:" & .Rows.Count).ClearContents 'RAZ
  If d.Count Then
    .[A2].Resize(d.Count) = Application.Transpose(d.items)
    .[A2].Resize(d.Count).TextToColumns .[A2], xlDelimited, _
      Other:=True, OtherChar:=Chr(1)
    .Columns.AutoFit 'ajustement automatique
    .Activate
  End If
End With
End Sub

A+

 

[damsdm]

Re : Copier plusieurs cellules de texte en une seule

@job75 Le principe est celui ci mais comment puis je faire pour que le regroupement garde le classement par année ?

Ta formule me donne la donnée quantitative dont j'ai besoin mais j'aurais besoin de la croiser avec l'année pour faire des stats. (par ex l'entreprise 2 devrait avoir deux fois "cap chateau" en 2008)

Merci pour ta réponse.

 

[job75]

Re : Copier plusieurs cellules de texte en une seule

Re,

Une nouvelle version donc, si j'ai bien compris ce que vous souhaitez :

Sub Regrouper()
Dim tablo, ub&, d As Object, i&, rest$(), a, txt$, j As Byte, t$, k&
tablo = Range("B2", Range("H" & Rows.Count).End(xlUp))
ub = UBound(tablo)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To ub 'liste des entreprises sans doublon
  If tablo(i, 7) <> "" Then d(tablo(i, 7)) = ""
Next
ReDim rest(d.Count - 1, 6) 'base 0
a = d.keys
For i = 0 To UBound(a)
  txt = a(i)
  rest(i, 0) = txt
  For j = 1 To 6
    t = ""
    For k = 1 To ub
      If tablo(k, 7) = txt Then
        If tablo(k, j) <> "" Then t = t & vbLf & tablo(k, j)
      End If
    Next
    rest(i, j) = Mid(t, 2)
  Next
Next
'---restitution---
With Sheets("Regroupe")
  .Rows("2:" & .Rows.Count).Delete 'RAZ
  With .[A2].Resize(d.Count, 7)
    .Value = rest
    .WrapText = True 'renvoi à la ligne
    .Rows.AutoFit 'ajustement automatique
  End With
  .Activate
End With
End Sub

Fichier (2).

A+

 

[damsdm]

Re : Copier plusieurs cellules de texte en une seule

Merci beaucoup c'est exactement cela.

 

[LAURENCE27]

Re : [RESOLU] Copier plusieurs cellules de texte en une seule

Bonsoir,

une petite question pour job75, comment fais tu pour mettre le bouton regrouper et le faire fonctionner ?
merci de ta reponse
laurence27