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
Au vu du problème posé en espérant être explicite que dois-corriger sur ce dernier pour qu'il marche

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

 

[Modeste]

Bonjour sevy1,

Pas sûr d'avoir tout compris, mais si tu écris

F1.[C2].Resize(F1.[c35000].End(xlUp).Row - 1, 5)

tu redimensionnes une plage de 153 lignes et 5 colonnes, au départ de la cellule C2 ... mais 5 colonnes après C2, il n'y a que des colonnes vides!?

Il me semble que dans les deux lignes concernées, je remplacerais C2 par A2 ??

 

[sevy1]

Bonjour
Effectivement je commence par la cellule C2 mais les cellules qui viennent après peuvent être vide ou pas c'est juste un extrait du tableau que j'ai pris sur la base que j'ai certaines lignes de la colonne F et G ont les valeurs

 

[sevy1]

Bonjour
Effectivement je commence par la cellule C2 mais les cellules qui viennent après peuvent être vide ou pas c'est juste un extrait du tableau que j'ai pris sur la base que j'ai certaines lignes de la colonne F et G ont les valeurs

 

[sevy1]

Bonjour
J'ai l'impression que je n'ai pas été très clair pour ce voici une formule matricielle que j'ai essayé de taper et elle marche mais je souhaite la codifier en VBA (nombre important de ligne) cette formule est saisie en colonne H de la feuille TABLO2

=INDEX(TABLO1!$E$2:$E$154;EQUIV(TABLO2!C2&TABLO2!F2;TABLO1!$C$2:$C$154&TABLO1!$G$2:$G$154;0))

 

[JCGL]

Bonjour à tous,
Salut mon Luc,

Voici à quoi je ferai appel :

Option Explicit

Sub Formule()
    Range("H2").FormulaArray = _
        "=IFERROR(INDEX(TABLO1!R2C5:R154C5,MATCH(TABLO2!RC[-5]&TABLO2!RC[-2],TABLO1!R2C3:R154C3&TABLO1!R2C7:R154C7,0)),"""")"
    Range("H2").AutoFill Destination:=Range("H2:H5000")
    Range("H2:H5000") = Range("H2:H5000").Value
    Range("H1").Select
End Sub

Bise mon Luc
A+ à tous

 

[sevy1]

Bonjour merci pour votre réponse juste pour ma culture est ce que votre solution traduite en vba s excecute plus rapidement que la formule ou les tableaux pour lesquels je voulais me lancer autrement dit quel avantage j ai Dr passer en vba

 

[gosselien]

Bonjour,

Le VBA est toujours plus rapide, c'est certain mais ça vaut la peine sur de nombreuses lignes, pas sur un fichier de 20 lignes 🙂

P.

 

[sevy1]

Bonjour JCGL
comment integrer ta solution dans une boucle pour quelle puisse etre recopiee sur les differentes lignes de la colonne H?

 

[gosselien]

Bonjour

Bonjour JCGL
comment integrer ta solution dans une boucle pour quelle puisse etre recopiee sur les differentes lignes de la colonne H?

cette ligne fait la copie de H2 à H5000 non ?

AutoFill Destination:=Range("H2:H5000")

 

[Modeste]

Bonjour sevy1, gosselien,
Salut Jean-Claude 😉

Toujours pas certain d'avoir bien compris, mais je ne pouvais pas ne pas venir embrasser en retour mon JC 😀

Si les colonnes G et H de tablo2 sont toujours vides, cette adaptation du code de départ semble donner les mêmes résultats que la formule matricielle (#N/A en moins)
... Pas testé sur les 35000 lignes annoncées!

Dim F2 As Worksheet
Dim tablo1()
Dim tablo2()
Dim tablo3()

Sub rechercher()
Set F1 = Feuil1
Set F2 = Feuil2
tablo1 = F1.[A2].Resize(F1.[c35000].End(xlUp).Row - 1, 7).Value
tablo2 = F2.[A2].Resize(F2.[c35000].End(xlUp).Row - 1, 8).Value

ReDim tablo3(UBound(tablo1) - 1)

For i = 0 To UBound(tablo1, 1) - 1
  tablo3(i) = tablo1(i + 1, 3) & "#" & tablo1(i + 1, 7) 'concat C et G de Feuil1 dans tablo3
Next i
For i = 1 To UBound(tablo2, 1)
  tablo2(i, 7) = tablo2(i, 3) & "#" & tablo2(i, 6) 'concat C et G de Feuil2 dans 7e colonne
Next i
For i = 1 To UBound(tablo2, 1)
  lig = Application.Match(tablo2(i, 7), tablo3, 0)
  If Not IsError(lig) Then tablo2(i, 8) = tablo1(lig, 5)
Next
F2.[A2].Resize(UBound(tablo2, 1), UBound(tablo2, 2)).Value = tablo2
F2.Columns(7).ClearContents
End Sub

 

[sevy1]

Bonjour
Merci pour vos reponses,
Modeste je teste votre solution quand je serais devant la machine et vous reviens

 

[sevy1]

bonjour Modeste, Le Forum
j'ai teste votre solution elle marche le seul soucis c'est la colonne G de tablo2 qui perd toutes ces donnees apres excecution.Cette colonne au depart n est pas toujours vide elle peut contenir des donnees. Pour resoudre ce probleme faut il creer un tablo tampon comme tablo3 au niveau de la deuxieme boucle pour?

 

[Modeste]

Bonsoir sevy1,

Je présume que tu as essayé de comprendre comment le code fonctionne? 2-3 petites adaptations suffisaient ... si j'ai bien compris?
Pour autant que tu n'annonces pas, par la suite, que les colonnes H et I contenaient elles-aussi parfois des données, essaie ce qui suit:

Dim F2 As Worksheet
Dim tablo1()
Dim tablo2()
Dim tablo3()

Sub rechercher()
Set F1 = Feuil1
Set F2 = Feuil2
tablo1 = F1.[A2].Resize(F1.[c35000].End(xlUp).Row - 1, 7).Value
tablo2 = F2.[A2].Resize(F2.[c35000].End(xlUp).Row - 1, 9).Value

ReDim tablo3(UBound(tablo1) - 1)

For i = 0 To UBound(tablo1, 1) - 1
  tablo3(i) = tablo1(i + 1, 3) & "#" & tablo1(i + 1, 7) 'concat C et G de Feuil1 dans tablo3
Next i
For i = 1 To UBound(tablo2, 1)
  tablo2(i, 8) = tablo2(i, 3) & "#" & tablo2(i, 6) 'concat C et F de Feuil2 dans 8e colonne
Next i
For i = 1 To UBound(tablo2, 1)
  lig = Application.Match(tablo2(i, 8), tablo3, 0)
  If Not IsError(lig) Then tablo2(i, 9) = tablo1(lig, 5)
Next
F2.[A2].Resize(UBound(tablo2, 1), UBound(tablo2, 2)).Value = tablo2
F2.Columns(8).ClearContents
End Sub