Recherche multiple sans doublon

Bonjour,

A partir du fichier joint, je souhaite réaliser une recherche sur un critère (SIREN_EPCI) pour extraire l'ensemble des résultats (SAGE_1, SAGE_2...) sans doublon.

Je ne sais pas si j'ai été claire mais je mets le fichier en pièce jointe, il sera plus explicite que moi.

Merci à tous pour votre participation.

Donald

Edit: J'ai modifié le fichier exemple en insérant un résultat type pour simplifier la compréhension.

Bonjour et bienvenue,

Es-tu certain(e) d'avoir envoyé le bon fichier?

Pas de données relatives à SAGE_1, SAGE_2, etc...

Cdlt.

Le fichier est le bon.

En fait sur l'onglet "base de données" il n'y a pas de mention à SAGE_1, SAGE_2...

Il peut y avoir plusieurs SAGE sur un même EPCI. Je cherche une formule pour extraire l'ensemble des SAGE sur un EPCI sur l'onglet "RECHERCHE" qui référence les EPCI de l'onglet "BASE_DONNEES" sans doublon.

Ex :

SIREN_EPCI SAGE_1 SAGE_2 ...

200040426 Adour MARNE ...

Pas d'idée ?

Je viens de modifier le fichier exemple pour simplifier la compréhension du résultat souhaité.

J'ai oublié de préciser que je souhaitais une, ou un ensemble, de formules, mais pas de VBA.

Petit up car j'ai vraiment besoin d'aide sur cette formule.

Merci à vous

Bonne journée

Bonsoir donald2001, Jean-Eric, le forum

Puisque les formulistes ne se sont pas manifestés, pas si simple en effet

Une solution VBA :

Option Explicit

Sub Regrouper_Compter()
Dim a, b(), w(), i As Long, n As Long, t As Long
    With Sheets("BASE_DONNES").Range("A1").CurrentRegion.Columns("b:d")
        a = .Value
    End With
    ReDim b(1 To UBound(a, 1), 1 To 1)
    n = 1: b(1, 1) = "EPCI"
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                Set .Item(a(i, 1)) = CreateObject("Scripting.Dictionary")
                .Item(a(i, 1)).CompareMode = 1
                n = n + 1: t = 1: b(n, 1) = a(i, 1)
            End If
            If Not .Item(a(i, 1)).exists(a(i, 2)) Then
                t = t + 3
                .Item(a(i, 1))(a(i, 2)) = VBA.Array(n, t)
                w = .Item(a(i, 1))(a(i, 2))
                If t > UBound(b, 2) Then
                    ReDim Preserve b(1 To UBound(a, 1), 1 To w(1))
                End If
                b(n, w(1) - 2) = a(i, 2)
                b(n, w(1) - 1) = a(i, 3)
                b(n, w(1)) = 1
            Else
                w = .Item(a(i, 1))(a(i, 2))
                b(w(0), w(1)) = b(w(0), w(1)) + 1
            End If
        Next
    End With
    b(1, 2) = "SAG_1": b(1, 3) = "AVANCEMENT_SAGE_1": b(1, 4) = "NB_COMM_SAGE_1"
    Application.ScreenUpdating = False
    'Création de la feuille et restitution
    With Sheets.Add.Cells(1).Resize(n, UBound(b, 2))
        .Value = b
        If UBound(b, 2) > 4 Then
            With .Offset(, 1).Resize(1, 3)
                .AutoFill .Resize(, UBound(b, 2) - 1)
            End With
        End If
        .Font.Name = "calibri"
        .Font.Size = 10
        .VerticalAlignment = xlCenter
        .BorderAround Weight:=xlThin
        .Borders(xlInsideVertical).Weight = xlThin
        With .Rows(1)
            .BorderAround Weight:=xlThin
            With .Offset(, 1).Resize(, .Columns.Count - 1)
                .Interior.ColorIndex = 38
            End With
            .Cells(1).Interior.ColorIndex = 36
        End With
        .Columns.AutoFit
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Sincères remerciements Klin89 !!

tu as tout à fait compris ce que je recherchais à faire !

Seulement je ne peux pas utiliser de VBA car cela fait planter nos logiciels internes

Je renouvelle mes remerciements et espère que cette solution pourra être utiliser par d'autres.

Si un "formuliste" veut se faire les dents sur mon problème je suis toujours preneur !

Donald