Discussion :

[jpvba]

Bonjour a vous cher amis du forum,



J'ai une fonctionne que j'utilise fréquemment auquel vous, mes amis, m'avez aidé a produire. Il s'agit de la fonctionne suivante permettant d'effectué comme la recherchev (vlookup) mais en trouvant toute les valeurs possibles en les séparant du retour de charriot.

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

Celle-ci fonctionne vraiment bien mais avec un temps d'Exécution quand même assez lent.


J'ai un code auquel j'aimerais accéléré étant donné qu'il est utiliser quand meme assez fréquemment et le temps d'Exécution est assez long (j'ai fermé le poste en question étant donné que la lenteur proviens de cette fonction).



Donc je voudrais voir avec vous si il y aurais un autre façon de faire afin de pouvoir exécuté rmult en lot au lieu de ligne à ligne afin de gagner du temps ou toute autre façon de faire me permettant de sauver du temps.



merci encore mille fois !!!

[joe.levrai]

Bonjour,

plus rapide que de balayer les lignes unes par unes, tu pourrais te tourner vers la combinaison FIND et FINDNEXT

https://docs.microsoft.com/fr-fr/off...cel.range.find

Cet exemple montre comment rechercher toutes les cellules de la plage A1:A500 dans la première feuille de calcul contenant la valeur 2 et comment la remplacer par la valeur 5.

Code :

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

1
2
3
4
5
6
7
8
9
10
With Worksheets(1).Range("a1:a500") 
    Set c = .Find(2, lookin:=xlValues) 
    If Not c Is Nothing Then 
        firstAddress = c.Address 
        Do 
            c.Value = 5 
            Set c = .FindNext(c) 
        Loop While Not c Is Nothing
    End If 
End With

[Patrice740]

Bonjour,

Ou en utilisant un tableau :

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
Function rmult(valeurachercher As Variant, plageachercher As Range, numcolonne As Long) As Variant
Dim u As Variant
Dim t As Variant
Dim i As Long
 
  t = plageachercher.Value
  For i = LBound(t) To UBound(t)
    If t(i, 1) = valeurachercher Then
      u = u & t(i, numcolonne) & Chr(10)
    End If
  Next i
  If Right$(u, 1) = Chr(10) Then u = Left$(u, Len(u) - 1)
  rmult = u
 
End Function

[jpvba]

Merci beaucoup a joe.levrai et a Patrice740 pour votre aide c'Est apprécié !!!

Avec le code tel quel de Patrice, je gagne le quart de vitesse qui est m'a fois merveilleux.


Par contre présentement j'affecte ce code ligne a ligne à partir d'une boucle. Le code ou plutôt l'exemple de code de joe.levrai semble être le même principe, mais peut-être que j'ai tors mais je ne vois pas comment l'appliquer en lot.


Est-ce qu'il y aurais, ou peut-être que c'Est impossible, de traité l'information en lot afin d'augmenté davantage la vitesse.


C'Est sur que je suis content du résultat du code de Patrice740 mais peut-être il y aurais autre chose, si non je vais mettre le tout comme étant résolu.


merci à vous tous !!!

[jpvba]

Pour la solution de joe.levrai,


JE suis un peu embêté, j'essaye de la paramêtré afin de pouvoir l'utilisé a toute les sauces.

J'arrive avec ceci mais je sais que c'est erroné ...

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
Function joelevrai(valeurachercher As Variant, plageachercher As Range, numcolonne As Long) As Variant
 
    Dim c As Range
    Dim firstAddress As Variant
 
 
    Set c = plageachercher.Find(valeurachercher, LookIn:=xlValues).Offset(, numcolonne).Value
 
    If Not c Is Nothing Then
 
        firstAddress = c.Address
 
        Do
          Set c = plageachercher.FindNext(c)
 
        Loop While Not c Is Nothing
 
    End If
 
 
 
End Function

J'ai enlevé la ligne remplaçant la valeur de 5 et ajouté le offset concernant la colonne a retourner ...

[marot_r]

Bonjour.

Là, avec ton code tu supposes que .Find va te retourner une cellule.

Il faudrait d'abord tester si c est n'est pas Nothing avant de vouloir s'en servir pour faire un offset.

A+

[patricktoulon]

bonjour

Bonjour.

Là, avec ton code tu supposes que .Find va te retourner une cellule.

Il faudrait d'abord tester si c est n'est pas Nothing avant de vouloir s'en servir pour faire un offset.

A+

non seulement ca mais l'offset ne te donnera pas forcement ce que tu souhaite avec numcolonne

en effet numcolonne c'est quoi

1. la colonne dans la quelle chercher les données ?
2. la colonne dans la quelle tu récupère la donnée dans les lignes trouvées par find ?

c'est pas la même chose et j'avoue que pour moi ,au fil du post par rapport a ta démo initiale ca devient ambiguë

d'autant plus que si tu fait un find dans une plage multicolonne et que les trouvés ne sont pas dans les mêmes colonnes ,l'offset sera différent forcement

dernière interrogation
si c'est bien une recherche sur une colonne ,c'est quoi l'intérêt d'obtenir une liste de même valeurs?

[jpvba]

Bonjour monsieur Toulon,

si c'est bien une recherche sur une colonne ,c'est quoi l'intérêt d'obtenir une liste de même valeurs?

Un meme produit peut être dans un autre mandat. Si le produit est dans un autre mandat, si j'effectue une modification dans ma base de donnée, je viens de faire une bourde monumentale et bousilliez un historique ... Si le produit est dans un mandat unique, il n'y a aucun problème de dénaturé le produit.

Bref dans mon cas la justification est très terrain ...


JE pourrais donner d'autre exemple sur de valeur multiple comme par exemple savoir les vehicules d'une personnes (1 personne peut avoir plusieurs véhicules), les parents d'une personnes, etc ... etc ...

[eriiic]

Bonjour à tous,

si c'est toujours trop lent, plutôt qu'une fonction qui sera appelée x fois et bouclera x fois sur les données, tu pourrais faire un Sub classique.
En une seule passe tu crées tous les éléments dans un dictionnary que tu colles à la fin.
eric

[jpvba]

Très excellente idée eriiic,


Je n'ai jamais fais de sub avec un dictionnaire. Mais ceux auquel on m'ai aidé sont habituellement hyper rapide. Je vais m'informer concernant les dictionnaires ...


Également avez-vous des pistes pour pouvoir construire celle-ci avec votre solution ???

[eriiic]

Si j'ai bien compris ton besoin tu peux broder autour de ça :

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
Sub appel()
    concat [A2:A4], [B2:B4], [C2:C4]
End Sub
 
Sub concat(plageRech As Range, plageRecup As Range, plDest As Range)
    Dim rech, recup, result()
    Dim dict, lig As Long
 
    rech = plageRech.Value
    recup = plageRecup.Value
    Set dict = CreateObject("Scripting.Dictionary")
    For lig = 1 To UBound(rech)
        If dict.exists(rech(lig, 1)) Then
            dict(rech(lig, 1)) = dict(rech(lig, 1)) & vbLf & recup(lig, 1)
        Else
            dict(rech(lig, 1)) = recup(lig, 1)
        End If
    Next lig
    ReDim result(1 To UBound(rech), 1 To 1)
    For lig = 1 To UBound(rech)
        result(lig, 1) = dict(rech(lig, 1))
    Next lig
    plDest = result
End Sub

eric

Sinon tu peux aussi faire une fonction matricielle que tu validerais sur la plage complète de résultat.
Mais il faut connaitre sinon l'utilisateur peut être déboussolé et avoir des difficultés s'il faut étendre les plages.

[jpvba]

Si j'ai bien compris ton besoin tu peux broder autour de ça

Bonjour Éric,

J'ai fais plusieurs tentative mais je n'ai jamais pu réussi a faire fonctionner le code.

J'arrive a qqchose du genre

Code :

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

1
2
3
Sub appel()
 Sheets("Travail").Range("c2:c65") = concat(Sheets("mandat").["A2:A642009"], Sheets("mandat").["B2:B642009"], Sheets("Travail").["g2:g65"])
End Sub

Pour résumé mon besoin je vais expliquer le tout autrement.


J'ai dans une feuille intitulé Travail, auquel j'ai des numéro de produit dans les cellules de la colonnes C. Je veux valider si ces mêmes numéros de produit sont présent dans la feuille mandat et contient des numéros de mandat afin de facilité la prise de décision dans mon travail. Pour prendre ma décisions je dois savoir dans quel mandat ces produits sont présent. Les numéros de produit sont dans la colonne A trié en ordre croissant dans la feuille mandat et les numéros de mandats correspondant sont dans la colonne B de la feuille mandat. Il se peut que le produit sois dans aucun ou plusieurs mandat. Je veux retourner tous les numéros de mandat correspondant dans la colonne G de ma feuille intitulé Travail le tous séparé par le retour de chariot.

Donc a la fin de la procédure / fonction dans ma feuille travail j'ai sur la même ligne un numéro de produit dans la cellule C et tous les numéro de mandat correspondant dans la cellule G.

Pour résumé

Feuille Travail : colonne C = numéro de Produit, colonne G = Tous les numéros de mandat si il y a lieu correspondant au numéro de produit de la même ligne le tout séparé par le retour de chariot


Feuille mandat : colonne A = numéro de produit, colonne B = numéro de mandat


Donc mon besoin est similaire a la recherchev (vlookup) mais je veux trouver tous les éléments et non seulement le premier. Je dois toujours trouver la valeur exact des mandats.




merci mille fois

[eriiic]

Tu trouves que ton appel ressemble à celui que j'ai fait ?
Ca doit être :

Code :

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

concat plageRech , plageRecup , plDest

Par contre je viens de voir que ta liste à contrôler est sur une plage différente de celle de recherche.
Tu te sens capable de modifier ce point ?
Il faut ajouter ce paramètre, et changer à partir de ReDim result
eric

Bon, j'avais 5 min.
Comme tu colles à droite de la liste à contrôler, je ne passe que le paramètre liste.
Rien tester mais ça pourrait ressembler à ça :

Code :

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

 j'aurai dû tester... A plus :-)

Et su coup l'appel devient :

Code :

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

concat2 plListe, plageRech, plageRecup

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
21
22
23
24
Sub appel()
    concat2 [A2:A4], [F2:F4], [G2:G4]
End Sub
 
Sub concat2(plListe As Range, plageRech As Range, plageRecup As Range)
    Dim rech, recup, liste
    Dim dict, lig As Long
 
    rech = plageRech.Value
    recup = plageRecup.Value
    liste = plListe.Value
    Set dict = CreateObject("Scripting.Dictionary")
    For lig = 1 To UBound(rech)
        If dict.exists(rech(lig, 1)) Then
            dict(rech(lig, 1)) = dict(rech(lig, 1)) & vbLf & recup(lig, 1)
        Else
            dict(rech(lig, 1)) = recup(lig, 1)
        End If
    Next lig
    For lig = 1 To UBound(liste)
        liste(lig, 1) = dict(rech(lig, 1))
    Next lig
    plListe.Offset(, 1) = liste
End Sub

eric

[jpvba]

Bonjour Éric,

Par contre je viens de voir que ta liste à contrôler est sur une plage différente de celle de recherche.
Tu te sens capable de modifier ce point ?

Je ne comprends vraiment pas le sens de la question ... Est-ce que je devrais faire un filtre élaboré sur la plage de recherche afin qu'il ne reste seulement les mêmes numéros de produit que mon critère de recherche pour que le code puisse fonctionner ??? Est-ce là que tu veux dire par la liste a contrôler est sur une plage différente de celle de recherche ??? Habituellement sur un vlookup la liste a contrôler est différente de celle de recherche ...

Comme tu colles à droite de la liste à contrôler, je ne passe que le paramètre liste.

Je colle a 4 colonne a droite, sois sur la colonne G (mes données identiques, numéro de produit est dans la colonne C) ... Je ne comprends pas le sens de je ne passe que le paramètre liste ...

merci beaucoup pour ton aide !!!!

[eriiic]

Ah, j'avais mal lu et inversé les deux feuilles.
Donc je réintroduit la plage destination :

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
Sub appel()
    concat [A2:A3], [C2:C6], [D2:D6], [G2:G3]
End Sub
 
Sub concat(plListe As Range, plageRech As Range, plageRecup As Range, plDest As Range)
    Dim rech, recup, liste
    Dim dict, lig As Long
 
    rech = plageRech.Value
    recup = plageRecup.Value
    liste = plListe.Value
    Set dict = CreateObject("Scripting.Dictionary")
    For lig = 1 To UBound(rech)
        If dict.exists(rech(lig, 1)) Then
            dict(rech(lig, 1)) = dict(rech(lig, 1)) & vbLf & recup(lig, 1)
        Else
            dict(rech(lig, 1)) = recup(lig, 1)
        End If
    Next lig
    For lig = 1 To UBound(liste)
        liste(lig, 1) = dict(rech(lig, 1))
    Next lig
    plDest = liste
End Sub

Je ne contrôle pas mais les paramètres 1 et 4 puis 2 et 3 doivent avoir la même taille.
eric

[jpvba]

Bonjour,


JE crois que nous somme proche,


SI j'utilise tel que tel sans avoir fais de filtre élaboré avec le nouveau code, c'Est rapide mais l'information retourner n'Est pas fiable.

Tous les lignes ont des numéro de mandat mais en réalité c'Est erroné. Seulement quelques uns en a.

[eriiic]

Bonjour,

Ah, oui, j'avais oublié de modifier un dernier tableau :

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
Sub concat2(plListe As Range, plageRech As Range, plageRecup As Range, plDest As Range)
    Dim rech, recup, liste
    Dim dict, lig As Long
 
    rech = plageRech.Value
    recup = plageRecup.Value
    liste = plListe.Value
    Set dict = CreateObject("Scripting.Dictionary")
    For lig = 1 To UBound(rech)
        If dict.exists(rech(lig, 1)) Then
            dict(rech(lig, 1)) = dict(rech(lig, 1)) & vbLf & recup(lig, 1)
        Else
            dict(rech(lig, 1)) = recup(lig, 1)
        End If
    Next lig
    For lig = 1 To UBound(liste)
        liste(lig, 1) = dict(liste(lig, 1))
    Next lig
    plDest = liste
End Sub

C'est bien entendu dict(liste(lig, 1) qu'il faut utiliser maintenant et non dict(rech(lig, 1))
Tu aurais pu trouver ;-)
Désolé pour le contretemps.
eric

[jpvba]

WOW !!!


C'Est pratiquement instantané ériiic !!!



Un gros merci !!!!

[jpvba]

Petite question (je présume la dernière)



Si j'ai seulement un élément dans la plListe, j'ai un erreur sur la ligne

Code :

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

For lig = 1 To UBound(liste)

Devrais-je alors ajouter un If dans cette circonstance ou plutot tricher avec mon range i.e. prendre la dernière ligne + 1 ou mettre UBound(liste) + 1


Que pensez-vous qu'elle est la solution optimale ???



merci encore !!!!!!

[eriiic]

Bonjour,

perso je testerais IsArray
Il y a peut-être un artifice pour éviter cette erreur mais je ne vois pâs.
eric