XL 2016 Recherche en fonction d’une série de nombres

[cmdavid]

Bonjour à tous,

Je cherche une formule pour en cherchant dans un tableau une série de nombre (179+180+183), j’ai le résultat correspondant au ligne 179, 180, 183, ect.

Je précise que les colonnes du tableau (C-E-F-H-I-J-K) en fonction de la série de nombre contiendront les mêmes informations, seul le pays peut être différent. Voir fichier joint.

Merci pour votre aide,

Cordialement,

 

[Lolote83]

Bonjour @cmdavid
Voici ton fichier en retour (voir feuil2)
En fait au lieu de concaténer les lignes souhaitées, j'ai mis plusieurs saisies possible.
En espérant que cela pourra correspondre à tes attentes
@+ Lolote83

 

[cmdavid]

Bonjour Lolote83,
je comprend ce que vous avez fait, mais mon problème est que la recherche doit partir de, exemple : 179+180+183
question, existe il la possibilité de séparer la série de chiffre, dans les conditions ou on peut avoir : 1+12+163 ...
et ainsi utiliser votre solution.
merci pour votre réponse

 

[job75]

Bonjour cmdavid, Lolote83, le forum,

Voyez le fichier joint et cette fonction VBA, à placer dans un module standard :

Function Rech_Nb$(tableau As Range, ref$, titrecol$, titrecolmult$)
Dim r As Range, P As Range, j%, n As Byte, i&
ref = "+" & ref & "+" 'encadrement
For Each r In tableau.Rows
    If InStr(ref, "+" & r.Cells(1) & "+") Then Set P = Union(IIf(P Is Nothing, r, P), r)
Next
If P Is Nothing Then Exit Function
If titrecol Like titrecolmult & "*" Then
    j = Application.Match(Left(titrecol, Len(titrecol) - 1), tableau.Rows(0), 0)
    n = Val(Right(titrecol, 1))
    For Each P In Intersect(P, tableau.Columns(j))
        i = i + 1
        If i = n Then Rech_Nb = P: Exit For
    Next
Else
    j = Application.Match(titrecol, tableau.Rows(0), 0)
    Rech_Nb = P(1, j)
End If
End Function

Formule en N3 à tirer à droite et vers le bas :

=Rech_Nb(Tableau1;$M3;N$1;"Desti")

Nota : le tableau source est structuré.

Notez l'indexation des titres en Q1:V1.

A+

 

[cmdavid]

Bonjour job75,
Merci ça fonctionne, merci aussi a Lolote83, votre solution me sera utile.
Cordialement,

 

[Lolote83]

Re bonjour,
Sinon, dans le même esprit que @job75 (que je salue au passage), une autre fonction personnalisée

Function Recherche2(xRech, xChps)
    xDecoupe = Split(xRech, "+")
    For Each xCell In Range("N1:Z1")
        xResult = Empty
        If xCell.Value = xChps Then
            If xCell Like "Desti*" Then
                xNum = Val(Right(xCell.Value, 1)) - 1
                If xNum <= UBound(xDecoupe) Then
                    xResult = Application.Index(Range("Tableau1[Desti]"), Application.Match(Val(xDecoupe(xNum)), Range("Tableau1[REF]"), 0))
                End If
            Else
                xResult = Application.Index(Range("Tableau1[" & xChps & "]"), Application.Match(Val(xDecoupe(0)), Range("Tableau1[REF]"), 0))
            End If
        End If
        If xResult <> Empty Then
            Recherche2 = xResult
            Exit For
        End If
    Next xCell
End Function

Fonction que tu appelles dans la cellule N3 =Recherche2($M3;N$1) puis tirer à droite et vers le bas
@+ Lolote83

 

[job75]

Ce n'est pas fini.

Cette macro dans le code de la feuille calcule les valeurs en colonne M et remplit le tableau des résultats :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, tablo, ncol%, resu(), i, x$, j%, nn&, n&
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = [Tableau1] 'tableau structuré, matrice, plus rapide
ncol = UBound(tablo, 2)
ReDim resu(1 To UBound(tablo), 1 To 1)
For i = 1 To UBound(tablo)
    x = ""
    For j = 2 To ncol
        If j <> 3 And j <> 6 Then 'Date et Desti exclus
            x = x & Chr(1) & tablo(i, j) 'concaténation
        End If
    Next j
    If d.exists(x) Then
        nn = d(x)
        resu(nn, 1) = resu(nn, 1) & "+" & tablo(i, 1)
    Else
        n = n + 1
        d(x) = n 'mémorise la ligne
        resu(n, 1) = tablo(i, 1)
    End If
Next i
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
With [M3]
    If n Then
        .Resize(n) = resu
        .Offset(, 1).Resize(n, 13) = "=Rech_Nb(Tableau1,RC" & .Column & ",R1C,""Desti"")"
        .Resize(n, 14).Borders.Weight = xlThin 'bordures
    End If
    With .Offset(n).Resize(Rows.Count - n - .Row + 1, 14)
        .ClearContents 'RAZ en dessous
        .Borders.LineStyle = xlNone
    End With
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Elle se déclenche quand on modifie ou valide une cellule quelconque.

 

[cmdavid]

Merci

 

[job75]

Bonjour cmdavid,

Toujours pas fini.

La macro de mon post #7 s'exécute chez moi en 0,14 seconde, c'est relativement lent.

C'est dû à la fonction Rech_Nb qui pour chaque cellule redétermine la plage correspondant au texte en colonne M.

Dans ce fichier (3) j'ai introduit la colonne intermédiaire N avec les adresses des plages correspondantes.

Cette colonne N pourra être masquée.

La macro s'exécute maintenant en 0,028 seconde, c'est 5 fois plus rapide.

A+

 

[cmdavid]

merci