Discussion :

[Qwazerty]

Salut

Pour répondre à un post sur DVP, j'ai eu besoin de rechercher si une valeur appartenait à une liste array.
J'ai dans un premier temps voulu utiliser Filter, malheureusement cette méthode recherche un texte partiel et retourne donc des entrée contenant qu'une partie du texte recherché.
Je suis alors tombé sur cette discussion et j'ai modifié un peu le code pour qu'il soit plus flexible et corresponde à mon besoin de recherche de valeur complète.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
'adapté à partir de
'https://www.developpez.net/forums/d1531998/logiciels/microsoft-office/excel/macros-vba-excel/tester-appartient-tableau/#post8316965
Function FilterEx(SourceArray, Match As String, Optional LookIn As XlLookAt = xlWhole, Optional Include As Boolean = True, Optional Compare As VbCompareMethod = vbTextCompare) As Variant
    Dim MyTab As Variant
    Dim ExactMatch As String
 
    MyTab = SourceArray
    ExactMatch = Match
 
    If LookIn = xlWhole Then
        'On ne prendra que la valeur exact
        MyTab = Split("¤" & Join(MyTab, "¤;¤") & "¤", ";")
        ExactMatch = "¤" & Match & "¤"
    End If
 
    'On effectue la recherche
    FilterEx = Filter(MyTab, ExactMatch, Include, Compare)
End Function
 
Function ExistInArray(SourceArray, Match As String) As Boolean
    'On utilise les paramètres par défaut de FilterEx
    ExistInArray = UBound(FilterEx(SourceArray, Match)) > -1
End Function

Vous avez peut-être une autre méthode plus simple, si c'est le cas je suis preneur.

++
Qwaz

[unparia]

Bonjour
Peut-être en t'inspirant de ceci (exemple) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim Tabl As Variant
   Tabl = Array("TOTO", "TITI", "TATA", "TONTON")
   ch = Chr(1) & Join(Tabl, Chr(1)) & Chr(1)
   MsgBox InStr(ch, Chr(1) & "TITI" & Chr(1)) > 0

et en tricotant sur cette base ?

[Qwazerty]

Salut

En effet c'est aussi une solution, ça peut sans doute faire gagner quelques lignes de code.

Merci.
++
Qwaz

[unparia]

Tu peux "tricoter" un peu plus, si tu veux.
Regarde ce que retournerait par exemple ceci ( avec le même code ) pour une "partielle" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MsgBox ch Like "*" & Chr(1) & "*ONT*" & Chr(1)

Et on peut faire beaucoup plus encore
Je te laisse maintenant tricoter sur ces bases. Je sais que tu vas le faire en t'amusant.
Amitiés

[Qwazerty]

Salut

Du coup vu qu'il faut utiliser deux structure de code différentes pour avoir une recherche par xlPart ou par xlWhole, c'est moins intéressant et me semble plus contraignant.

Je connais Like et il me semble même, de mémoire, que Like est un opérateur plutôt lent (bon cii ça n'aurait sans doute pas grande importance je te l'accord )

En effet ça m'amuse beaucoup mais je suis déjà sur des "jeux" qui me prennent pas mal de temps ^^.

++
Qwaz

[edelweisseric]

Bonjour à toutes et tous

Si j'ai bien compris (?), j'utilise ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub test()
Dim tablo
 
tablo = Array(25, 124, 963, 745)
 
MsgBox Not IsError(Application.Match(745, tablo, 0)) 'renvoi vrai
MsgBox Not IsError(Application.Match(74, tablo, 0)) 'renvoi faux
MsgBox Not IsError(Application.Match("vasypoupou", tablo, 0)) 'renvoi faux
MsgBox Application.Match(124, tablo, 0) 'renvoi 2 (2ème index du tablo)
 
End Sub

mais je ne suis pas encore assez réveillé

Eric

[Qwazerty]

Salut

En effet c'est intéressant aussi.

Un avantage, on peut utiliser les critères génériques.
Un inconvénient Match ne tient pas compte de la case.

Du coup il serait intéressant de l'utiliser à la place de FilterEx pour bénéficier de la possibilité d'employer les caractères génériques... à voir quand j'aurais un peu de temps

Merci.
++
Qwaz

[edelweisseric]

Bonsoir

Peut-être comme cela :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub test()
Dim tablo
 
tablo = Array("toto", 25, 124, 963, 745)
' pour essai
' Var = "toto"
' Var = "Toto"
' Var = 24
' Var = 25
Var = "Tutu"
 
If Not IsError(Application.Match(Var, tablo, 0)) = "Faux" Then MsgBox "La valeur n'est pas dans l'Array": Exit Sub
If Var = tablo(Application.Match(Var, tablo, 0) - 1) Then
    MsgBox "La valeur est dans l'Array"
Else
    MsgBox "La valeur n'est pas dans l'Array"
End If
End Sub

Bien entendu, s'il y a : "Dupont" et "dupont", cela se complique

Eric

[joe.levrai]

Bonjour,

une variante de unparia sous forme de fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Public Function IsInArray(ValeurCherchée As Variant, ArrayDeRecherche As Variant) As Boolean
    If Not IsArray(ArrayDeRecherche) Then Exit Function
    IsInArray = InStr(1, vbNullChar & Join(ArrayDeRecherche, vbNullChar) & vbNullChar, vbNullChar & ValeurCherchée & vbNullChar) > 0
End Function

[Pierre Fauconnier]

Salut.

Attention avec Application.Match, ça ne fonctionnera tel quel que pour Excel.

Hors de l'environnement Excel, il faudra utiliser Excel.Application.match à condition d'avoir référencé la librairie Excel, sinon il faudra travailler en late binding

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
  Dim app As Object
 
  Set app = CreateObject("Excel.Application")
  MsgBox app.match("Martine", Array("pierre", "martine"), 0)

Ce n'est dont pas une solution pur vba...

[pijaku]

Bonjour à tous,

Je n'aime pas me servir de Match lorsque l'on parle de variable tableau.
En effet, quitte à faire une fonction de recherche dans un tableau, autant que celle-ci soit efficiente sur toutes tailles de tableau.
Or Match plante au-delà des limites d'Excel 2003 (65 536).

Quitte également à faire une fonction nous disant si la valeur est présente dans l'Array, autant faire une fonction qui nous dit ou elle est.
Et tant qu'à faire, cette fonction devrait être efficace pour tout type d'Array (1 ou 2 dimension au moins)...

Voici donc ce que j'utilises depuis quelques temps (années ?????) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Function Get_Row(ByVal Tableau As Variant, Texto, Optional Colonne As Long) As Long
'Détermine l'index d'un élément à partir de son contenu
'Retourne un Long représentant l'index de cet élément
'Retourne -1 si l'élément n'existe pas dans le tableau ou erreur (de colonne, de Tableau, etc).
Dim i As Long, strTemp As String
   Get_Row = -1
   Select Case Nb_Dimensions(Tableau)
       Case 1
'===== le présent code, déposé par ucfoutu sur VBFrance, est la seule propriété de VBFrance
'=====VBFrance en autorise les libres copie et utilisation à la seule condition d'y laisser
'=====insérées les trois présentes lignes commentées --- ucfoutu ---
         strTemp = Chr(0) & Join(Tableau, Chr(0)) & Chr(0)
         i = InStr(strTemp, Chr(0) & Texto & Chr(0))
         If i = 0 Then
            Get_Row = -1
         Else
            strTemp = Mid(strTemp, 1, i)
            Get_Row = UBound(Split(strTemp, Chr(0))) - 1
            If Get_Row < 0 Then Get_Row = -1
         End If
'======================
      Case 2
         'si paramètre colonne omis, on prends la première
         If Colonne = 0 Then Colonne = LBound(Tableau, 2)
         For i = LBound(Tableau, 1) To UBound(Tableau, 1)
            If Tableau(i, Colonne) = Texto Then Get_Row = i: Exit For
         Next i
   End Select
End Function
 
Function Nb_Dimensions(Tableau As Variant) As Integer
'Retourne le nombre de dimensions d'une variable tableau
Dim d As Integer, t As Long
   On Error GoTo Fin
   Do
      d = d + 1
      t = UBound(Tableau, d)
   Loop
Fin:
   On Error GoTo 0
   Nb_Dimensions = d - 1
End Function

Et je disposes, comme cela, de plusieurs fonctions utiles pour travailler sur des Arrays, que j'ai placé dans un module de mon classeur de macros personnelles.

EDIT : à la relecture de cette discussion, je me rends bien compte que ma fonction mérite encore bien des améliorations.
Entres autres :
> la casse respectée ou non,
> la recherche partielle
etc.

[Pierre Fauconnier]

Salut Franck,

[...]
Or Match plante au-delà des limites d'Excel 2003 (65 536).[...]

Peux-tu expliquer dans quel cas? J'ai déjà réalisé des matchs sur des tableaux et des plages d'un million de lignes en VBA sans soucis.

[joe.levrai]

Ceci plante

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub toto()
Dim Tabl(1 To 80000)
For i = 1 To 80000
    Tabl(i) = i
Next i
 
Tabl(6) = "toto"
Set app = CreateObject("Excel.Application")
MsgBox app.Match("toto", Tabl, 0)
End Sub

je pensais pourtant qu'en passant par ta méthode avec le createobject() allait dépasser cette fichue limite que je confirme rencontrer souvent.

Tu as une astuce pour ça Pierre ?

[pijaku]

Salut Franck,
Peux-tu expliquer dans quel cas? J'ai déjà réalisé des matchs sur des tableaux et des plages d'un million de lignes en VBA sans soucis.

Salut Pierre,

J'ai repris le test d'Eric (edelweiss) comme suit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Option Base 0
 
Sub test()
Dim t(65535) As String, u(65536) As String, var As String, i As Long
 
var = "liste21"
 
For i = LBound(t) To UBound(t)
   t(i) = "liste" & i
Next
 
For i = LBound(u) To UBound(u)
   u(i) = "liste" & i
Next
 
If Not IsError(Application.Match(var, t, 0)) = "Faux" Then MsgBox "La valeur n'est pas dans l'Array": Exit Sub
If var = t(Application.Match(var, t, 0) - 1) Then
    MsgBox "La valeur est dans l'Array"
Else
    MsgBox "La valeur n'est pas dans l'Array"
End If
 
'l'erreur 13 incompatibilité de type se déclenche à la ligne suivante :
If Not IsError(Application.Match(var, u, 0)) = "Faux" Then MsgBox "La valeur n'est pas dans l'Array": Exit Sub
If var = u(Application.Match(var, u, 0) - 1) Then
    MsgBox "La valeur est dans l'Array"
Else
    MsgBox "La valeur n'est pas dans l'Array"
End If
End Sub