VBA: Recherchev Plusieurs Résultats

J'ai besoin d'un peu d'aide avec un peu de code.

Je suis en train d'effectuer une Recherchev, et les données sont affichées dans les colonnes O, P et Q.

Ce que je suis en train de faire est de la boucle si la feuille("Global") de colonne d'Un départ à la ligne 3 jusqu'à la dernière utilisation de la ligne. Il a besoin de faire correspondre les données dans la feuille (les"Détails") dans la colonne de départ à la ligne 2.

Alors, quand il trouve une valeur correspondante, il affiche les résultats de "Détails" C2 "Global" O2 "Détails" I2 "Global" de la P2 et de "Détails" G2 "Global" T2.

Il doit alors en boucle, même si les "Global" d'appariement et de copier toutes les données. Si aucune correspondance n'est trouvée, l'affichage "NA!".

La dernière chose dont j'ai besoin pour faire est de supprimer toutes les lignes dans Global, où un match n'a pas été trouvé.

Le code que j'ai ci-dessous fait ce que j'ai besoin, le seul problème est qu'il est incroyablement lent, le procès-verbal de la boucle si 800 lignes, parfois même plus!!

Est-il une autre façon de le faire, ce qui sera plus fluide et plus rapide?

Toute aide est très appréciée!!

Merci

`Private Sub btnVlookUp_Click()
Dim i, j, lastG, lastD As Long

' find last row
lastG = Sheets("Global").Cells(Rows.Count, "B").End(xlUp).Row
lastD = Sheets("Details").Cells(Rows.Count, "A").End(xlUp).Row

' loop over values in "Global"
For i = 3 To lastG
    lookupVal = Sheets("Global").Cells(i, "B") ' value to find

    ' loop over values in "details"
    For j = 2 To lastD
        currVal = Sheets("Details").Cells(j, "A")

        If lookupVal = currVal Then
            Sheets("Global").Cells(i, "O") = Sheets("Details").Cells(j, "C")
            Sheets("Global").Cells(i, "P") = Sheets("Details").Cells(j, "I")
            Sheets("Global").Cells(i, "Q") = Sheets("Details").Cells(j, "G")
            ' mark the row
            Sheets("Details").Cells(j, "Z") = "marked"

        End If
    Next j
Next i

' loop over rows in "details" and delete rows which have not been marked
For j = 2 To lastD
    If Sheets("Details").Cells(j, "Z") <> "marked" Then
        ' delete unmarked rows
        Sheets("Details").Cells(j, "A").EntireRow.Delete
        If Sheets("Details").Cells(j, "B") <> "" Then
            j = j - 1 ' revert iterator so it doesn't skip rows
        End If
    Else:
        ' remove the mark
        Sheets("Details").Cells(j, "Z") = ""
    End If
Next j
End Sub`

OriginalL'auteur atame | 2015-08-04