[Résolu] Accélérer rechercheV

[adel53]

Bonjour le forum

Aujourd’hui j'ai besoin de votre aide pour accélérer un traitement que je dois réaliser.

Je dois faire une recherche simple de l'ensemble des éléments d'une colonne dans une autre feuille et affiche un résultat si on trouve une correspondance exacte.
Mon tableau fait aujourd’hui 90000 lignes ce qui rend le calcul trop long j'ai commencé par utilisé la rechercheV qui devait monopoliser mon pc pendant une vingtaine de minutes je suis passé à Index equiv qui était légèrement plus rapidement mais toujours long 15-20 min. J'ai donc rédigé une macro avec for each et find afin d'aller plus vite.

Pouvez vous svp m'aider à améliorer cette macro ou me proposer des solutions plus optimales pour ce type de traitement.
Je vous ai joins un fichier exemple dans celui là on cherche les valeur de la colonne A de l'onglet "All" dans la colonne A de l'onglet "PI-GRN" si on trouve une correspondance on remplit la colonne K de l'onglet "All"

Sub vlookup()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Dim Trouve As Range, PlageDeRecherche As Range, c As Range
    Dim derligne As Long
    derligne = Range("A1").End(xlDown).Row
    Set PlageDeRecherche = Sheets("PI-GRN").Range("A1:A" & derligne)
    
    For Each c In Sheets("All").UsedRange.Columns("A").Cells
        Debug.Print c.Value
        With PlageDeRecherche
            Set Trouve = .Columns(1).Cells.Find(What:=c.Value)
            On Error GoTo 0
            
            If Trouve Is Nothing Then
                'AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
            Else
                c.Offset(0, 10) = Trouve.Offset(0, 1)
            End If
        End With
    Next c
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Merci

 

[Dranreb]

Re : Accélérer rechercheV

Bonjour.

Sub vloukup()
Dim T(), D As New Dictionary, L&
T = Feuil3.[A1].Resize(Feuil3.[A60000].End(xlUp).Row, 2).Value
For L = 1 To UBound(T, 1): D(T(L, 1)) = T(L, 2): Next L
T = Feuil4.[A1].Resize(Feuil4.[A60000].End(xlUp).Row).Value
For L = 1 To UBound(T, 1)
   If D.Exists(T(L, 1)) Then T(L, 1) = D(T(L, 1)) Else T(L, 1) = Empty
   Next L
Feuil4.[K1].Resize(UBound(T, 1)).Value = T
End Sub

Nécessite la référence Microsoft Scripting Runtime.

 

[adel53]

Re : Accélérer rechercheV

Merci pour ton aide je vais essayer et revenir vers toi

 

[BOISGONTIER]

Re : Accélérer rechercheV

Bonjour,

Fonction plus rapide que Recherchev()

JB

 

[adel53]

Re : Accélérer rechercheV

Merci JB je teste ta méthode aussi

 

[adel53]

Re : Accélérer rechercheV

Messieurs Merci bcp pour votre aide

Je vais utiliser la version de Dranreb qui même si je n'ai pas compris grand chose je pense que tu as utilisé des array dynamique. Peux tu stp me détailler le fonctionnement de ta macro.

La rechercheM de Mr JB est très bien aussi plus simple pour l'utilisateur car on la lance à partir d'une cellule excel et peut s'adapter facilement à différent cas. j'ai juste peur de la validation matricielle qui n'est pas inné chez l'ensemble des utilisateurs

Merci

 

[Dranreb]

Re : [Résolu] Accélérer rechercheV

Sub vloukup()
Dim T(), D As New Dictionary, L&
'   Déclare un tabeau de Variant dynamique T, un Dictionary D et une variable L As Long

T = Feuil3.[A1].Resize(Feuil3.[A60000].End(xlUp).Row, 2).Value
'  Charge en T les valeurs à partir de la cellule A1 de la feuille représentée par l'objet Worksheet
'     nommé Feuil3 dans la rubrique "Microsoft Excel Objets" du projet, pour un nombre de lignes égal
'     au numéro de la dernier cellule renseignée jusqu'à A60000, et 2 colonnes

For L = 1 To UBound(T, 1): D(T(L, 1)) = T(L, 2): Next L
'  Pour L = 1 jusqu'au nombre de lignes du tableau: crée s'il y a lieu une clé dans le dictionnaire
'  dont la valeur est celle de la colonne 1 à cette ligne, et la valeur d'item celle de la colonne 2

T = Feuil4.[A1].Resize(Feuil4.[A60000].End(xlUp).Row).Value
'  Réutilise le tableau pour autre chose: seulement les valeurs colonne 1 de la Feuil4

For L = 1 To UBound(T, 1)
'  Pour L = 1 jusqu'au nombre de lignes du tableau
   If D.Exists(T(L, 1)) Then T(L, 1) = D(T(L, 1)) Else T(L, 1) = Empty
   '  Si la clé existe on la remplace par la valeur d'item, sinon par rien.
   Next L
   
Feuil4.[K1].Resize(UBound(T, 1)).Value = T
'  Décharge le tableau à partir de la cellule K1
End Sub

 

[adel53]

Re : [Résolu] Accélérer rechercheV

Super merci bcp pour votre aide