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

  • Initiateur de la discussion Initiateur de la discussion cmdavid
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

cmdavid

XLDnaute Occasionnel
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,
 

Pièces jointes

Solution
Bonjour cmdavid, Lolote83, le forum,

Voyez le fichier joint et cette fonction VBA, à placer dans un module standard :
VB:
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 =...
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
 
Bonjour cmdavid, Lolote83, le forum,

Voyez le fichier joint et cette fonction VBA, à placer dans un module standard :
VB:
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 :
Code:
=Rech_Nb(Tableau1;$M3;N$1;"Desti")
Nota : le tableau source est structuré.

Notez l'indexation des titres en Q1:V1.

A+
 

Pièces jointes

Re bonjour,
Sinon, dans le même esprit que @job75 (que je salue au passage), une autre fonction personnalisée
VB:
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
 
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 :
VB:
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.
 

Pièces jointes

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+
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
3
Affichages
470
Réponses
36
Affichages
3 K
Retour