Recherchev dans les tableaux (VBA) avec deux conditions

[sevy1]

Bonjour Le Forum
J'ai un souci j'ai deux feuilles dans chaque feuille il y a des données je voudrais récupérer une valeur de la feuille1 (colonne E) et l'inscrire à la feuille2 (colonne H) si les valeurs de la colonne C et G de la feuille 1 sont identiques à celle de la feuille2. Je passe par les tableaux pour besoin de rapidité (comme lu dans le forum) je commence par nommer mes tableaux à partir de la colonne C (selon les enseignement du forum).
Voici ce que j'ai essayé de faire mais ça rame très lent car j'ai près de 35000 lignes.
Pourriez vous me donner une solution optimale VBA
Merci d'avance
----------------------------------------
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim tablo1()
Dim tablo2()
Dim tablo3()

Sub rechercher()
Set F1 = Feuil1
Set F2 = Feuil2
tablo1 = F1.[C2].Resize(F1.[c35000].End(xlUp).Row - 1, 5).Value
tablo2 = F2.[C2].Resize(F2.[c35000].End(xlUp).Row - 1, 5).Value
ReDim tablo3(1 To UBound(tablo2, 1), 1 To 2)

For i = 1 To UBound(tablo2, 1)
For j = 1 To UBound(tablo1, 1)
If tablo2(i, 1) = tablo1(j, 1) And tablo2(i, 5) = tablo1(j, 4) Then F2.Range("H" & i + 1) = tablo1(j, 3): GoTo 0 'tablo3(i,1)=tablo1(j,4)
Next
0 Next
'F2.[g2].Resize(UBound(tablo2, 1), UBound(tablo2, 2)).Value2 = tablo3
End Sub

 

[sevy1]

Bonjour Modeste
Des excuses pour la réponse tardive.
J'ai bien testé la dernière solution elle marche, avec le peu que j'ai appris du forum j'essaie de comprendre les instructions à l'exception de celle du redimensionnement

 Resize(UBound(tablo2, 1), UBound(tablo2, 2))

je sais qu'on parle de Resize(ligne;colonne) ?

 

[Modeste]

Bonsoir,

Le Resize que tu évoques là était déjà présent dans ton code de départ !?
Cette propriété redimensionne une plage (ici, au départ de la cellule A2 de Feuil2) aux (2) dimensions du tableau en mémoire. La plage ainsi redimensionnée reçoit ensuite les données du même tableau en mémoire (tablo2)

 

[sevy1]

Une fois de plus merci

 

[mapomme]

Bonjour tout le monde,

J'avais commencé à bricoler un 'truc' à partir d'un dictionary. Finalement, je l'ai terminé. Je le poste pour le fun.

Edit: s'il y a plusieurs fois le même couple dans tablo1 , la clef retenue sera celle du dernier couple. Si on veut celle du premier couple, il faut parcourir tablo1 du bas vers le haut pour le remplissage de dico1.

Sub recherche_mapomme()
Dim t, dico1, c
  t = Timer
  Set dico1 = CreateObject("scripting.dictionary")
  Set F1 = Feuil1: Set F2 = Feuil2

  'remplacer g par h pour n'effacer que la colonne h
  F2.Range("g2:h" & Rows.Count).ClearContents
  tablo1 = F1.[c2].Resize(F1.[c1000000].End(xlUp).Row - 1, 5).Value
  'dico1 :  clef = concaténation de tablo1(i, 1) et de tablo1(i, 5)
  '         item = tablo1(i, 3)
  For i = 1 To UBound(tablo1)
    dico1("\" & tablo1(i, 1) & "\" & tablo1(i, 5) & "\") = tablo1(i, 3)
  Next i

  'pour chaque ligne de tablo2, on cherche sa correspondance dans dico1
  'si elle existe,        on la place dans la colonne 1 de tablo2
  'si elle n'existe pas,  on place "" dans la colonne 1 de tablo2
  tablo2 = F2.[c2].Resize(F2.[c1000000].End(xlUp).Row - 1, 5).Value
  For i = 1 To UBound(tablo2)
    c = "\" & tablo2(i, 1) & "\" & tablo2(i, 4) & "\"
    If dico1.exists(c) Then tablo2(i, 1) = dico1(c) Else tablo2(i, 1) = ""
  Next i

  'tablo2:  on ne garde que la colonne 1
  ReDim Preserve tablo2(1 To UBound(tablo2), 1 To 1)
  ' on écrit le résultat sur la feuille
  ' remplacer "g" par la colonne de destination
  F2.Range("g2").Resize(UBound(tablo2)) = tablo2
  F2.Range("g1") = "mapomme"
  MsgBox Round(Timer - t, 1)
End Sub