Fusion de plage de cellules ayant un même ID et une même cat

Bonjour à tous,

je sollicite votre aide pour résoudre un problème sur lequel je bloque depuis des heures... tout ce que j'ai pu lire sur les forums m'indique que seul VBA peut m'aider... mais je n'ai pas trouver un problème identique. Et, je n'y connais malheureusement rien à VBA .

Donc voilà, j'ai un très gros fichier (env 20000 lignes).

dans ce fichier j'ai :

• ETAB_id en colonne A (identifiant d'un lieu)
• Presta_id en colonne B (catégorie de prestation)
• Presta_title en colonne C (nom de la catégorie)
• Descriptif en colonne D (texte décrivant la prestation)

je peux avoir pour un même Etablissement, plusieurs prestations avec le même ID & titre, mais avec une description différente.

Et j'aimerais regrouper tous ces descriptifs ayant une catégorie identique dans un seule cellule (en les séparant avec un caractère type | ou / etc...).

Pour que ça soit plus parlant j'ai créé un fichier excel type avec 2 souhaits de résulats espérés.

Je ne sais pas si il existe une solution à mon problème, mais je vous remercie d'avance pour l'aide que vous pourrez m'apporter.

Merci d'avance

A.

Mouais, mais bon voilà une autre solution sans VBA avec une autre présentation plus aérée ...

Bonjour,

et merci Steelson pour ton retour... j'avais fait un TCD mais le résultat n'est pas ce que je recherche. C'est vrai que ca présente mieux, mais je n'obtiens pas pas ce que je souhaiterais.

Tu crois qu'il y a une possibilité d'obtenir l'une ou l'autre présentation que j'avais mis ds le fichier joint ?

bonne journée

A.

Bonsoir anto75, Steelson

Vois ceci :

Option Explicit
Sub test()
Dim a, b(), i As Long, n As Long, txt As String
    a = Sheets("Feuil1").Range("a1").CurrentRegion.Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
    With CreateObject("Scripting.Dictionary")
        .comparemode = 1
        For i = 2 To UBound(a, 1)
            txt = Join$(Array(a(i, 1), a(i, 2), a(i, 3)), Chr(2))
            If Not .exists(txt) Then
                n = n + 1
                b(n, 1) = a(i, 1)
                b(n, 2) = a(i, 2)
                b(n, 3) = a(i, 3)
                .Item(txt) = n
            End If
            b(.Item(txt), 4) = b(.Item(txt), 4) & _
                            IIf(b(.Item(txt), 4) <> "", "|", "") & a(i, 4)
        Next
    End With
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("resultat").Delete
    Sheets.Add().Name = "Resultat"
    On Error GoTo 0
    With Sheets("resultat").Cells(1)
        .Resize(, UBound(a, 2)).Value = a
        With .Offset(1).Resize(n, UBound(b, 2))
            .Value = b
        End With
        With .CurrentRegion
            .Font.Name = "calibri"
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .VerticalAlignment = xlCenter
            With .Columns("a:c")
                .HorizontalAlignment = xlCenter
                .ColumnWidth = 19
            End With
            With .Rows(1)
                .Font.Size = 11
                .BorderAround Weight:=xlThin
                .Interior.ColorIndex = 36
            End With
        End With
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Merci Klin89, ça me parait plutôt bien ! je vais le tester en "réel"...

merci encore pr ton aide.

A.

bonjour Klin,

je souhaitais te dire que ca fonctionne correctement, et te remercier à nouveau.

A bientôt

A.