recopie formule et/ou mettre résultats

[erics83]

Bonjour,

J'ai un classeur avec la feuille "Base" contenant beaucoup de ligne.

Dans une des colonnes, je fais un INDEX/EQUIV pour trouver des correspondances, mais vu le nombre de lignes, cela prend beaucoup de temps et le poids du classeur en prend un coup aussi....

N'y aurait-il pas une solution, pour qu'à l'ouverture du classeur, les correspondances entre les feuilles "Base" et "Nom" se fassent ?

En vous remerciant par avance,

 

[DoubleZero]

Re : recopie formule et/ou mettre résultats

Bonjour, erics83, le Forum,

Un essai en pièce jointe.

A bientôt

 

[néné06]

Re : recopie formule et/ou mettre résultats

Bonjour Eric,

Salut OO

Une autre méthode!

Option Base 1
Private tablo()
Private tablo1()
Public Sub ecriture_tab_diff_donnees()
numli1 = Sheets("Base").Cells.Find("*", , , , , xlPrevious).Row
tablo = Range("A2:A" & numli1).Value 'charge tablo
numli = Sheets("Nom").Cells.Find("*", , , , , xlPrevious).Row
tablo1 = Sheets("Nom").Range("A1:B" & numli).Value 'charge tablo1
For i = 1 To UBound(tablo)
d = Application.Match(tablo(i, 1), Sheets("Nom").Range("A:A"), 0)
Sheets("Base").Cells(i + 1, 6) = tablo1(d, 2)
Next i
End Sub

A+

René

 

[DoubleZero]

Re : recopie formule et/ou mettre résultats

Re-bonjour, bonjour, néné06 ,

...Une autre méthode!...

néné06 ,

* L'occasion m'est donnée, ici, de te remercier.

Pour quelle raison ? Tu m'as fait comprendre que la méthode "Match" est bien plus rapide que la méthodes "Find".

Après quelques minutes , heures , jours , semaines ... j'en ai, me semble-t-il, assimilé la "recette".

Pour ce qui concerne les tabl..., je crois que je "mourirai" avant d'en avoir saisi le raisonnement. Cela n'est pas grave : l'important, pour moi, est le *.

A bientôt

 

[néné06]

Re : recopie formule et/ou mettre résultats

Re,

@ 00

Merci pour le post #4, mais pour les tableaux, je suis persuadé que tu vas vite les adopter !

@ tous
un version un peu plus optimisée !

Option Base 1
Public Sub ecriture_tab_diff_donnees()
Dim tablo()
Dim tablo1()
Dim tablo2()
numli1 = Sheets("Base").Cells.Find("*", , , , , xlPrevious).Row
tablo = Range("A2:A" & numli1).Value 'charge tablo
tablo2 = Range("A2:A" & numli1).Value 'charge tablo
numli = Sheets("Nom").Cells.Find("*", , , , , xlPrevious).Row
tablo1 = Sheets("Nom").Range("A1:B" & numli).Value 'charge tablo1
For i = 1 To UBound(tablo)
tablo2(i, 1) = 5
tablo2(i, 1) = tablo1(Application.Match(tablo(i, 1), Sheets("Nom").Range("A:A"), 0), 2)
Next i
Range(Cells(2, 6), Cells(numli1, 6)).Resize(UBound(tablo2, 1)) = tablo2
End Sub

A+
René

 

[job75]

Re : recopie formule et/ou mettre résultats

Bonsoir erics83, hello chère ânesse, néné06,

Application.Match ne sera pas plus rapide que la fonction EQUIV puisque c'est la même chose

Si l'on veut vraiment aller vite il faut utiliser le Dictionary :

Sub Dico()
Dim d As Object, t, i&, P As Range
Set d = CreateObject("Scripting.Dictionary")
t = Feuil2.[A1].CurrentRegion.Resize(, 2) 'feuille Nom
For i = 1 To UBound(t)
  d(t(i, 1)) = t(i, 2)
Next
Set P = Feuil1.[A1].CurrentRegion.Resize(, 6) 'feuille Base
t = P
For i = 2 To UBound(t)
  If d.exists(t(i, 1)) Then t(i, 6) = d(t(i, 1)) Else t(i, 6) = ""
Next
P.Columns(6) = Application.Index(t, , 6)
End Sub

Testé les 2070 lignes de la feuille "Base" sur Win 8 - Excel 2013 :

- macro du post #3 => 0,12 seconde

- macro du post #5 => 0,06 seconde

- macro de ce post => 0,02 seconde.

A+

 

[néné06]

Re : recopie formule et/ou mettre résultats

Re,

@ Job75

Bonsoir Job

C'est vrai que "Dictionary" est plus rapide, mais je crois que notre ami Eric à un fichier de plus de 200000 lignes et "Dictionary" est limité à 65535 données, je pense.
La version du post#5 =>0.07 seconde

A+

René

 

[job75]

Re : recopie formule et/ou mettre résultats

Re René,

mais je crois que notre ami Eric à un fichier de plus de 200000 lignes et "Dictionary" est limité à 65535 données, je pense

Il n'y a aucune limite de ce genre pour le Dictionary, ensuite ici le nombre d'items est le nombre de noms en feuille "Nom".

J'ai complété mon post #6 avec la durée d'exécution de ta 2ème macro.

A+

 

[job75]

Re : recopie formule et/ou mettre résultats

Re,

Testé sur 206900 lignes :

- macro du post #3 => 14,3 secondes

- macro du post #5 => 5,4 secondes

- macro du post #6 => 1,8 seconde.

Bonne fin d soirée.

 

[job75]

Re : recopie formule et/ou mettre résultats

Re,

Par comparaison les formules INDEX/EQUIV du post #1 sur 206900 lignes s'exécutent en 3,7 secondes :

Sub test()
Dim t
t = Timer
[F2:F206901].Formula = [F2:F206901].Formula
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub

Bonne nuit.

 

[job75]

Re : recopie formule et/ou mettre résultats

Bonjour erics83, 00, René, le forum,

En ne chargeant que la 1ère colonne du tableau c'est nettement plus rapide :

Sub Dico()
Dim dur, d As Object, t, i&, P As Range, rest$()
dur = Timer
Set d = CreateObject("Scripting.Dictionary")
t = Feuil2.[A1].CurrentRegion.Resize(, 2) 'feuille Nom
For i = 1 To UBound(t)
  d(t(i, 1)) = t(i, 2)
Next
With Feuil1 'feuille Base
  Set P = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)(3)) 'au moins 2 éléments
End With
t = P
ReDim rest(1 To UBound(t), 1 To 1) 'base 1
For i = 1 To UBound(t)
  If d.exists(t(i, 1)) Then rest(i, 1) = d(t(i, 1))
Next
'MsgBox "Durée du calcul " & Format(Timer - dur, "0.00 \s")
'dur = Timer
P.Columns(6) = rest
MsgBox "Durée " & Format(Timer - dur, "0.00 \s")
End Sub

Durée d'exécution sur 206900 lignes => 0,8 seconde dont :

- 0,5 seconde pour le calcul (remplissage du tableau rest)

- 0,3 seconde pour la restitution dans la feuille.

Bonne journée.

 

[néné06]

Re : recopie formule et/ou mettre résultats

Re,

@ Job
Bien vu le programme, je suis convaincu !

A+

rené