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.

[jpvba]

Bonjour Promethee,


J'ai besoin que la function retourne une cellule a gauche ou a droite de celle contenant une information contenant un nombre déterminer de caractères de la valeur a chercher

je voudrais pourvoir spécifier une colonne précise auquel correspond l'information a retourner un peu comme recherchev (vlookup).

Également like ne permet pas de dire le nombre de caractères identiques auquel je veux dans ma recherche.

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

Pour ajouter un saut de ligne j'utilise habituellement Chr(10)


merci quand meme pour l'énergie consacré a me répondre

[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

[jpvba]

Bonjour Anasecu,

J'ai essayé le code mais j'arrive a aucun résultat.







Est-ce que tu peux voir ce qui cloche ???

N.B. j'ai renommer a l'aide de rechercher/remplacer, rmultunique par testunique

[anasecu]

Bonsoir,

J'ai essayé le code mais j'arrive a aucun résultat.

Ce doit être un peu normal car on s'est mal compris.
Tu es parti sur l'idée de recherchev avec l'idée que la colonne résultat est à l'intérieur de la plage.
J'ai raisonné à la manière de index/equiv qui permet d'être en dehors de la plage

Donc si tu remplaces ton 1 par "F" par exemple tu devrais avoir des résultats.

[jpvba]

J'ai effectivement maintenant des résultat mais je n'arrive pas a ce que c'Est supposé

A fin de test, j'est mis un 1 comme nbrcar dans la rangé 1, 2 dans la rangé 2, etc ... jusqu'à 8



Dans le résultat de nbrcar 1, j'ai des doublons

Dans le résultat de nbrcar 2, j'aurais dû également avoir comme résultat 6 et 8 car bjur j'ai bonjour

Dans le résultat de nbrcar 3, j'aurais dû également avoir comme résultat 4 car dans jour, j'ai jou et our qui sont 3 caractères juxtaposé appartenant a bonjour


Dans le résultat de nbrcar 4, j'aurais dû également avoir comme résultat 1 car dans njour, j'ai njour qui sont 4 caractères juxtaposé appartenant a bonjour

également le résultat 4 car dans jour, j'ai 4 caractères juxtaposés appartenant a bonjour

Dans le résultat de nbrcar 5, j'aurais dû avoir 1, car njour a 5 caractères identiques appartenant bonjour au lieu d'avoir aucun résultat.

Dans le résultat 6 et 7, on aurais dû avoir aucun aulieur erreur de valeur car bonjour a 7 caractères, je comprends que 8 est un erreur

[anasecu]

Bonsoir,

J'ai effectivement maintenant des résultat mais je n'arrive pas a ce que c'Est supposé

Je n'avais pas beaucoup de temps et j'avais fait les modifications un peu rapidement.
Cela devrait mieux aller me semble-t-il en fonction de tes observations.

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
Function testunique(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)
Application.Volatile
    For nb = 1 To Len(valeurachercher) - nbcar + 1
        tabval(UBound(tabval)) = "*" & LCase(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 LCase(elm.Value) Like tabval(itv) Then
                If InStr(1, testunique, Cells(elm.Row, colonne).Value) = 0 Then
                    testunique = testunique & Cells(elm.Row, colonne).Value & vbLf
                End If
                Exit For
            End If
        Next itv
    Next elm
End Function

[jpvba]

Là, ca marche a merveille !!!


Un gros merci encore une fois !!!