VLookup dans une macro excel Résolu

Question

Bonjour à tous, 

J'ai toujours trouvé réponse à mes questions sur ce site, c'est pourquoi je viens encore chercher de l'aide.

Je travaille sur Excel 2000 (eh oui !!)

J'ai un fichier (P) de 36 000 enregistrements de type adresse et un autre (R) de 5 000 avec les mêmes colonnes mais qui sont des enregistrements à supprimer DANS P.

En clair, je souhaite que la macro recherche dans P successivement tous les enregistrements de R et qu'une fois trouvé, la ligne de P soit supprimée.

Après des recherches et des consultations de forums, j'ai essayé d'écrire ma macro que je vous recopie ici :

Sub SupprimR()
'
' SupprimR Macro
' 

Dim wshR As Worksheet
Dim wshP As Worksheet

Derlig = Range("A" & Rows.Count).End(xlUp).Row

For i = Derlig To 3 Step -1
  If WorksheetFunction.VLookup("R!A2", "P!A1:H5334", 1, False) = wshR.Range("A2") Then
  Rows(i).Delete
            End If
    Next
End Sub

Bien évidemment ça ne fonctionne pas, la ligne qui commence par If est surlignée en jaune et c'est tout !

Merci d'avance à tous ceux qui prendront attention à cet appel au secours !

Configuration: Windows XP / Internet Explorer 7.0

Ménilmuche · Answer

J'ai oublié de signaler que je voulais faire un essai sur une colonne pour voir si cela fonctionnait mais en réalité toutes les colonnes de P doivent être testées car il peut y avoir des homonymes complets mais qui sont à des adresses différentes.
Si c'est OK pour une cellule, j'ajouterai des "And" !

J'attends impatiemment votre aide. Merci d'avance.

michel_m · Answer

bonjour, 

les identifiants sont ils bien colonne A ? 

combien il y a t il de colonnes dans tes tableaux ? 

Tu parjles de fichiers puis tu déclares des feuilles ..... ? 

  La première ligne est elle utilisée pour des nomS de champs ?
  
 Michel

michel_m · Answer

Code brut de fonderie (le code sera commenté si OK)
durée pour 500 R: 10 secondes  peut-^tre astuce pour rapidité dans mes cartons

Sub supprimer_PsiR()
Dim T_r(), T_p(), D_r As Object, D_p As Object
Dim decal As Long, Cptr As Long, Ligne As Long
Dim start As Single

start = Timer
Application.ScreenUpdating = False

 créer_dico_concat "R", T_r, D_r
 T_keyR = D_r.keys
 créer_dico_concat "P", T_p, D_p
 T_keyP = D_p.keys
 Erase T_r, T_p
 
While D_r.Count > 0
     decal = 1
     For Cptr = LBound(T_keyR) To UBound(T_keyR)
          Ref = T_keyR(Cptr)
          If D_p.exists(Ref) Then
               Ligne = Application.Match(Ref, T_keyP, 0) + decal
               Sheets("P").Rows(Ligne).Delete
               decal = decal - 1
          End If
          D_r.Remove Ref
     Next
Wend
Application.ScreenUpdating = True
MsgBox "durée : " & Timer - start & " .sec."
End Sub

'--------------------------

Sub créer_dico_concat(onglet, tablo, dico)
Dim Derlig As Long, Lig As Long, Col As Byte, Ref As String
With Sheets(onglet)
     Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
     tablo = .Range("A2:H" & Derlig).Value
     
     Set dico = CreateObject("scripting.dictionary")
     For Lig = 1 To UBound(tablo)
          Ref = ""
          For Col = 1 To 8
               Ref = Ref & tablo(Lig, Col)
          Next
               If Not dico.exists(Ref) Then dico.Add Ref, ""
     Next

End With

End Sub

Je dois m'absenter pour 1 heure ou 2 (ou 3!)

VLookup dans une macro excel

3 réponses

Newsletters