rapidité de recherche....

[erics83]

Bonjour,

J'ai un classeur, 2 feuilles.
Feuille1 : en A, le numéro de siret des entreprises; en B le nom des entreprises. Il y a 350000 lignes.....
En Feuille2, une compilation de différents fichiers commerciaux : en A : le siret de l'entreprise, en B, le type de contact (téléphone, mail, etc...)

Donc, jusqu'à présent, je faisais un index/equiv dans la feuille2 qui allait me chercher en feuille1 le siret et mettait en colonne C, le nom de l'entreprise (récupéré de la feuille1) .

Mon soucis est le temps.... : Ma feuille2 est alimentée chaque mois d'environ 10000 données. Au début la recherche était "rapide", mais maintenant ma feuille2 atteint les 200000 lignes et Index/equiv devant chercher dans les 350000 lignes de la feuille1, cela met beaucoup de temps....

j'ai essayé Dictionary, formules matricielles (merci JB..), mais cela prend beaucoup de temps.

Auriez vous une petite idée et/ou solution ?

En vous remerciant pour votre aide,

 

[pierrejean]

Re
il faudrait un fichier exemple avec quelques lignes pour tester et comparer diverses formules

 

[erics83]

Bonjour,

J'y ai pensé, mais le fichier est très lourd, même compressé......

 

[pierrejean]

Re
Fais une copie et supprime jusqu'a 99% des données (voire moins encore ;c'est la structure qui est importante)

 

[job75]

Bonjour erics83, Pierre, le forum,

Avec le Dictionary c'est rapide, voyez le fichier RechercheRapide et ce code dans Module1 :

Public d As Object 'mémorise la variable

Function RechercheRapide(v As Double, col1 As Range, col2 As Range)
If d Is Nothing Then CreerDico col1, col2
RechercheRapide = d(v)
End Function

Sub CreerDico(col1 As Range, col2 As Range)
Dim t1, t2, i&
On Error Resume Next 'si le tableau est vide
t1 = Intersect(col1, col1.Parent.UsedRange) 'matrice, plus rapide
t2 = Intersect(col2, col2.Parent.UsedRange)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t1)
d(t1(i, 1)) = t2(i, 1)
Next
End Sub

Le Dictionnary est recréé chaque fois qu'on modifie les colonnes A:B de Feuil1 :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A:B]) Is Nothing Then CreerDico Columns(1), Columns(2)
End Sub

Sur Win 10 - Excel 2013 le recalcul des 200 000 formules en colonne C de Feuil2 prend 11 secondes.

Avec INDEX/EQUIV ou RECHERCHEV le recalcul prend plusieurs minutes.

Fichiers zippés joints.

Bonne journée.

 

[erics83]

Bonjour job75,

Merci pour tout ces apports.
J'ai testé vos fichiers et effectivement Dictionary est nettement plus rapide.
En fait, je viens de m'apercevoir que c'est mon ordinateur fixe qui est vraiment lent, car je suis loin des 11 secondes. J'ai essayé avec un autre ordinateur (portable) et je suis effectivement à 11 secondes...qui sont vraiment nettement plus rapide que mes INDEX/EQUIV....Merci pour votre code que je vais pouvoir ré-utiliser à foison.

Merci pour votre aide,
Eric

 

[job75]

Re,

J'ai constaté chez moi qu'Excel a parfois du mal à s'en sortir vu la taille du fichier.

Par exemple quand on efface entièrement les colonnes A:B en Feuil1.

A tout hasard j'ai ajouté cette ligne de code à la fin de CreerDico, ça semble aller mieux :

Application.ScreenUpdating = True 'le rafraîchissement de l'écran semble utile...

Edit : non en fait ça ne change rien.

Il y a même des problèmes parfois quand on ne fait rien du tout.

Cela vient de la manière dont le fichier s'est ouvert, si on le rouvre plus de problème.

A+

 

[job75]

Bonjour erics83, Pierre, le forum,

Les numéros Siret ont 14 chiffres, j'ai voulu voir ce que ça donne.

Eh bien s'ils sont stockés sous forme de nombres et traités As Double on ne s'en sort pas : j'ai abandonné le test de recalcul après quelques minutes.

Pour s'en sortir il faut les stocker sous forme de textes et les traiter As String :

Function RechercheRapide(v As String, col1 As Range, col2 As Range)

Voyez le fichier joint, chez moi le recalcul s'effectue en 22 secondes, c'est acceptable.

Bonne journée.

 

[erics83]

Bonjour et Merci job75,

J'avais machinalement rajouté le screenupdating = true à la fin de votre premier code.
J'ai essayé votre nouveau code sur mon ordi fixe, effectivement avec la méthode String, c'est plus rapide....Merci.

Super merci job75,
Bonne journée,

 

[laetitia90]

bonjour Eric , Pierre jeanJob

je vais peut être dire une grosse bêtise

comme je comprends le pb.. eric il rajoute environ 1000 lignes de plus tous les mois il a plus besoin
des formules dans les anciennes données 200000 lignes ???? si c'est le cas !! autant les convertir en value
perso je garderai que la formule de la derniere ligne puis autofill sur col c sur la new plage ect...

un debut de code basique

Dim r As Long
  r = Cells(Rows.Count, 3).End(3).Row - 1
Range("c2" & ":c" & r).Value = Range("c2" & ":c" & r).Value

 

[job75]

Bonjour erics83, Pierre, Laetitia, le forum,

Dans ce fichier (2) il n'y a plus de formules.

Cela réduit le risque de plantage.

Bonne journée.

 

[erics83]

Bonjour,

Bonjour et merci Laetitia90, oui en ne retenant que les valeurs, c'est vrai que c'est plus rapide, mais le souci est la "lecture" de la base des siret et des noms des entreprises (=feuil1), c'est cela qui prend du temps car 350000 lignes....donc, même si je ne mets que 10000 nouvelles lignes chaque mois, c'est la lecture des 350000 lignes et la recherche qui prend du temps, d'où le stockage en dictionary.

Bonjour et merci job75,
J'ai testé votre fichier, j'ai modifié la cellule jaune (=mis un nouveau nom), le code me dit : Dictionary en 9,38 secondes, bien !! par contre lorsque je clique sur la feuil2, la modification ne s'est pas opérée, et au bout de quelques secondes un code se met en route et se bloque avec "incompatibilité de type 13", au niveau de

a.Columns(3) = Application.Index(t, , 3)

. Je n'ai rien fait, ni touché au code, j'ai juste modifié le nom présent dans la case jaune et cliqué sur l'onglet de la Feuil2 pour voir le résultat, comme vous me suggériez...

En vous remerciant pour votre aide,

 

[Roland_M]

bonjour tout le monde !

j'ai eu le même problème que Erics !

EDIT:
c'est l'événement qui est déclenché lorsqu'on passe sur l'onglet Feuil2 !
Private Sub Worksheet_Activate()

et donc appel de la routine
Calcul [A:C] là où ça plante !

a.Columns(3) = Application.Index(t, , 3)

.Index(t, , 3) < ceci !?

 

[job75]

Re, salut Roland,

Très curieux ce bug, il ne se produit pas chez moi sur Win 10 - Excel 2013.

Essayez avec a.Columns(3).Value = Application.WorksheetFunction.Index(t, 0, 3)

et si ça ne va toujours pas utilisez a.Value = t (qui prend un peu plus de temps).

Nota : bien sûr la modification de Feuil2!C2 n'est pas immédiate puisque tout le tableau est étudié.

A+

 

[laetitia90]

re tous roland

je pense que je me suis mal expliqué
ta formule aller bien pour peu de cells maintenant 200000 formules cela ne peut que être tres lent
il est imperatif de bosser seulement sur les cells ajoutées plus rapide aussi bien par formule que vba
comme je comprends tu rajoute des données a la suite donc colonne c vide on peut dimensionner facilement un tablo on peut essayer une macro directement
r = Feuil2.Cells(Rows.Count, 1).End(3).Row'colonne a
c = Feuil2.Cells(Rows.Count, 3).End(3).Row + 1 colonne c
la on connait les dimension du tablo
tablo = Feuil2.Range("a" & c & ":a" & r)
déja supprime les formules exist... avec le code donne plus haut enleve le -1

Sub es()
  Dim t(), i As Long, m As Object, s As Long, r As Long, c As Long, s as long
  With Application: .ScreenUpdating = 0: .DisplayAlerts = 0: .EnableEvents = 0: .Calculation = 0: End With
    s = Timer
  r = Feuil2.Cells(Rows.Count, 1).End(3).Row
  c = Feuil2.Cells(Rows.Count, 3).End(3).Row + 1
   Set m = CreateObject("Scripting.Dictionary")
   t = Feuil2.Range("a" & c & ":a" & r)
   For i = 1 To UBound(t): m(t(i, 1)) = "": Next i
   t = Feuil1.Range("a2:b" & Feuil1.Cells(Rows.Count, 1).End(3).Row)
   For i = 1 To UBound(t)
   If m.Exists(t(i, 1)) Then m(t(i, 1)) = t(i, 2)
   Next i
   t = Feuil2.Range("a" & c & ":a" & r)
    For i = 1 To UBound(t): t(i, 1) = m(t(i, 1)): Next i
   Feuil2.Range("c" & c).Resize(UBound(t)) = t
   m.RemoveAll: Erase t
   With Application: .ScreenUpdating = 1: .DisplayAlerts = 1: .EnableEvents = 1: .Calculation = 1: End With
MsgBox "Realisée en...  " & Format(Timer - s, "0.00") & "   secondes"
End Sub

normalement <1 seconde sur 10000 lignes ajoutées....... on peut encore optimisée