recopie formule et/ou mettre résultats

erics83 · 13 Mars 2016

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 · 13 Mars 2016

Re : recopie formule et/ou mettre résultats

Bonjour, erics83, le Forum,

Un essai en pièce jointe.

A bientôt

néné06 · 13 Mars 2016

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 · 13 Mars 2016

Re : recopie formule et/ou mettre résultats

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

néné06 à dit:
...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 · 13 Mars 2016

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 · 13 Mars 2016

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 :

Code:

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 · 13 Mars 2016

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 · 13 Mars 2016

Re : recopie formule et/ou mettre résultats

Re René,

néné06 à dit:
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 · 13 Mars 2016

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 · 13 Mars 2016

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 :

Code:

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 · 14 Mars 2016

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 :

Code:

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 · 14 Mars 2016

Re : recopie formule et/ou mettre résultats

Re,

@ Job
Bien vu le programme, je suis convaincu !

A+

rené

recopie formule et/ou mettre résultats

erics83

XLDnaute Impliqué

Pièces jointes

DoubleZero

XLDnaute Barbatruc

Pièces jointes

néné06

XLDnaute Accro

Pièces jointes

DoubleZero

XLDnaute Barbatruc

néné06

XLDnaute Accro

Pièces jointes

job75

XLDnaute Barbatruc

néné06

XLDnaute Accro

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

néné06

XLDnaute Accro

Discussions similaires