Discussion :

[jpvba]

Bonjour a vous,

J'ai un besoin particulier afin de pouvoir recherche dans une plage une valeur qui contient l'élément de départ.


Exemple, je dirais que ma valeur a trouver dois avoir 4 éléments identique de ma valeur de départ. Par exemple ma valeur de départ ce serais col6589, et les résultats pourrais etre col6, 6589, ol65 mais non les élément non juxtaposé (c659, ol89, ...)

Le résultat devrais etre dans une cellule unique dont chacun des éléments est sur une ligne différente.


On pourrais ajouter l'élément de code a la fonction ci-dessous (on enlèverai du meme coup les doublons)

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
Function rmultUnique(valeurachercher As Variant, plageachercher As Range, numcolonne As Long) As String
Dim u As Variant
Dim nb As Long
Dim boucle As Long
 
Dim tabval() As Variant
 
ReDim tabval(plageachercher.Rows.Count)
 
nb = 1
u = ""
For boucle = 1 To plageachercher.Rows.Count
    If plageachercher(boucle, 1) = valeurachercher Then
        tabval(nb) = plageachercher(boucle, numcolonne)
        nb = nb + 1
    End If
Next boucle
For i = 1 To nb - 1
   For j = i + 1 To nb - 1
      If tabval(i) = tabval(j) Then tabval(j) = ""
   Next j
Next i
For i = 1 To nb
   If tabval(i) <> "" Then u = u & tabval(i) & Chr(10)
Next i
If Right$(u, 1) = Chr(10) Then u = Left$(u, Len(u) - 1)
 
rmultUnique = u
End Function

merci encore une fois pour votre aide !!!

[Thautheme]

Bonjour JP, bonjour le forum,

Comme les fonctions me posent encore certains problèmes, je te propose une solution macro avec la méthode InStr et Dictionary. Il te suffira de l'adapter à ta fonction...

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
Sub Macro1()
Dim VR As String 'déclare la variable VR (Valeur Recherchée)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément de ligne)
Dim J As Integer 'déclare la variable J (incrément de colonne)
Dim TMP As Variant 'déclare la variable TMP (Tableau TeMPoraire)
 
VR = Range("H1").Value 'définit la valeur recherchée VR (à adapter à ton cas)
TV = Range("A1").CurrentRegion 'definit le tableau des valeurs TV (à adapter à ton cas)
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 1 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV
    For J = 1 To UBound(TV, 2) 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV
        'si la valeur de la donnée ligne I colonne J est contenue dans la valeur recherchée VR
        'alimente le dictionnaire D de la valeur de la donnée ligne I colonne J
        If InStr(1, VR, TV(I, J), vbTextCompare) > 0 Then D(TV(I, J)) = TV(I, J)
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
'renvoie dans la cellule J1 (à adapter à ton cas) la liste des éléments du dictionnaire D sans doublons
Range("J1").Resize(D.Count, 1) = Application.Transpose(D.keys)
End Sub

[anasecu]

Bonjour,

En espèrant que j'ai compris ta problèmatique, je te propose cette fonction qui recherche 4 caractères consécutifs de "valeurachercher" dans la "plageachercher" en éliminant les doublons.

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
Function rmultUnique(valeurachercher As Variant, plageachercher As Range) As String 
Dim elm As Range
Dim nb As Long, itv As Long
ReDim tabval(0)
    For nb = 1 To Len(valeurachercher) - 3
        tabval(UBound(tabval)) = "*" & Mid(valeurachercher, nb, 4) & "*"
        ReDim Preserve tabval(UBound(tabval) + 1)
    Next nb
    ReDim Preserve tabval(UBound(tabval) - 1)
    For Each elm In plageachercher
        For itv = 0 To UBound(tabval)
            If elm.Value Like tabval(itv) Then
                If InStr(1, rmultUnique, elm.Value) = 0 Then
                    rmultUnique = rmultUnique & elm.Value & vbLf
                End If
                Exit For
            End If
        Next itv
    Next elm
End Function

[jpvba]

Merci pour l'aide Thautheme !!!

Dans la solution proposé, je ne peux dire le nombre de caractère identique de la valeur a chercher auquel la valeur a trouver doit contenir. Je suis malheureusement pas encore assez expérimenté en VBA afin d'ajouter cette variable et la faire fonctionner dans le code proposé.

[jpvba]

Également un gros merci pour ton aide Anasecu !!!


Cependant avec ton code, je ne peux prédéterminer le nombre de caractère identique de la valeur a chercher ... je présume on peut mettre une variable au lieu de 4.


Également, je crois que je me suis mal exprimé, mai je voudrais pourvoir spécifier une colonne précise auquel correspond l'information a retourner un peu comme recherchev (vlookup). Donc si une cellule contiens le nombre d'élément identique de la valeur chercher dans une plage, je pourrais dire laquelle des colonnes auquel j'ai besoins de l'information à retourner.

Également, l'information retourner est bout a bout ... il faudrait ajouter un retour de ligne afin de faciliter la lecture


merci beacoup encore une fois pour le temps consacré a vouloir m'aider/résoudre mon problème.

amicalement


JP

[Promethee25]

Bonjour,

Si les cellules à récupérer sont celles contenant uniquement un extrait de ta valeur de départ et rien d'autre, je te propose de te contenter de l'opérateur like pour la comparaison:

Code :

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

1
2
3
4
5
    For Each rg In MaPlageDeRecherche
        If "col789" Like "*" & rg.Value & "*" Then
            'cellule correspondant à mon critère
        End If
    Next rg

L'astuce ici consistant non pas à comparer chaque case parcourue à ta valeur de départ mais plutôt la valeur de départ à chaque case parcourue (j'ai mis ton exemple de valeur de départ en dur dans le code mais c'est à adapter).

Pour insérer un saut de ligne, il faut concaténer avec vbcrlf.

[anasecu]

Bonsoir,

je ne peux prédéterminer le nombre de caractère identique de la valeur a chercher

Je t'ai rajouté le paramètre facultatif à 4 en implicite

Également, je crois que je me suis mal exprimé, mai je voudrais pourvoir spécifier une colonne précise

Je t'ai remis le paramètre et tu peux mettre "C" ou 3 si tu veux.

Également, l'information retourner est bout a bout ... il faudrait ajouter un retour de ligne afin de faciliter la lecture

Non il y a bien le retour de ligne mais il faut que ta cellule ai le code "renvoyer à la ligne automatiquement" coché

Amicalement avec le code corrigé

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
Function rmultUnique(valeurachercher As Variant, plageachercher As Range, colonne As Variant, Optional nbcar = 4) As String
Dim elm As Range
Dim nb As Long, itv As Long
ReDim tabval(0)
    For nb = 1 To Len(valeurachercher) - nbcar - 1
        tabval(UBound(tabval)) = "*" & Mid(valeurachercher, nb, nbcar) & "*"
        ReDim Preserve tabval(UBound(tabval) + 1)
    Next nb
    ReDim Preserve tabval(UBound(tabval) - 1)
    For Each elm In plageachercher
        For itv = 0 To UBound(tabval)
            If elm.Value Like tabval(itv) Then
                If InStr(1, rmultUnique, elm.Value) = 0 Then
                    rmultUnique = rmultUnique & Cells(elm.Row, colonne).Value & vbLf
                End If
                Exit For
            End If
        Next itv
    Next elm
End Function