J'ai une BD (base de donnée) où est listé tous mes fournisseurs connu (tableau A3:C10), avec les renseignements correspondant.
Je récupére d'un autre côté la liste des fournisseurs d'un autre logiciel (colonne E => E4 à E16).
Je veux m'assurer que tous les fournisseurs récupérés sur l'autre logiciel figure bien dans ma base de donnée!
Je pensais utiliser une boucle basique :
Code:
For ligneBD = 4 To [A4].End(xlToDown).Row
Next ligneBD
Ou une boucle plus adapté :
Code:
For Each Plage In Range(Range("A4:A" & [A4].End(xlToDown).row))
...
Next
Mais en faisant des recherches, j'ai appris que ces deux boucles avait un temp d'éxécution assez long (et comme j'ai beaucoup de données à analyser...). Il semblerait que l'utilisation de la fonction Find soit mieux adapté à mon cas et surtout plus rapide!
Mais voila, après lecture de la notice Excel, plusieurs recherche sur le net, plusieurs tentatives, je n'arrive pas à l'utiliser!
Voici ci-joint un petit exemple commenté, ainsi qu'un début de macro.
Si quelqu'un pouvait m'aider me rajouter les 2 lignes de code qu'il me manque, il m'enlèverais une belle épine du pied.
A moins qu'il ait une autre approche tout aussi efficace (voir plus)?
Problème : avec un échantillon de 120 fournisseurs en colonne A, 10206 fournisseurs en colonne C (liste avec des doublons), les procédures sans "UNION" (avec "ScreenUpdating" fixé à false) tournent en 1,9 à 2,8 secondes. La procédure avec "UNION" met plus de 2 minutes et 10 secondes.
La question est : Pourquoi ?
(Bien entendu, les essais sont faits dans le même environnement.)
(quoi? je m'enfonce? bon ok, je vais donc pas continuer plus loin, faute de ne bientôt plus avoir pied!)
Désolé pour ma maladresse et encore merci à tous.
Je sens que pour me rattraper, sur ce coup, il va falloir que j'aide bcp de monde cette semaine!
Profitez en!! Venez tous poser vos questions!!! Mais pitié, qu'elles soient facile svp car je ne suis pas très doué en Excel
Salut soenda
Bonsoir le Fil
Bonsoir le Forum
Arff Trop rapides (les réponses lol)
Je cherchais Une macro qui date (2006 de Vériti) et qui a l'époque avait montré que l'utilisation des collections était un moyen très rapide de traiter à l'époque plusieurs dizaines de milliers de données
j'ai donc bidouillé ce Fichier , mais je ne sais pas trop utiliser les compteurs(Timer) si quelqu'un veut bien tester et me dire Lol Merci d'avance
j'ai testé avec 15000 lignes dans chaque listes et j'ai ainsi récupéré une une liste d'une trentaine de Données , non présentent dans la première Liste (cela ma semblé assez rapide Lol)
"je regarde demain pour la macro de VériTi"
Bonne Fin de Soirée
Intéressant, tout ça... La dernière proposition (ChTi160) adaptée aux conditions du problème donne :
Code:
[COLOR="DarkSlateGray"]Option Base 1
Sub Test2()
Dim TabF1 As Variant
Dim TabF2 As Variant
Dim L1 As Long
Dim L2 As Long
Dim Coll_Fourn As Collection
Application.ScreenUpdating = False
Set Coll_Fourn = New Collection
On Error Resume Next
With Worksheets("Feuil1")
TabF1 = .Range(.Cells(4, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)).Value
With .Range(.Cells(4, 3), .Cells(.Cells(.Rows.Count, 3).End(xlUp).Row, 3))
TabF2 = .Value
.Interior.ColorIndex = 6
End With
For L1 = 1 To UBound(TabF1, 1)
Coll_Fourn.Add TabF1(L1, 1), CStr(TabF1(L1, 1))
Next L1
For L2 = 1 To UBound(TabF2, 1)
Coll_Fourn.Add TabF2(L2, 1), CStr(TabF2(L2, 1))
If Err.Number Then .Cells(L2 + 3, 3).Interior.ColorIndex = xlNone
Err.Clear
Next L2
End With
Application.ScreenUpdating = True
End Sub[/COLOR]
Elle n'offre pas de performances supérieures à la plupart des autres propositions.
La meilleur synthèse que j'ai testée est
Code:
[COLOR="DarkSlateGray"]Sub FrsNonRéférencé2() 'Roger
Dim oCelC As Range, oDat
Application.ScreenUpdating = False
Set oDat = Worksheets("Feuil1").Range("A4:" & Range("A4").End(xlDown).Address)
With Worksheets("Feuil1").Range("C4:" & Range("C4").End(xlDown).Address)
.Interior.ColorIndex = xlNone
For Each oCelC In .Cells
If WorksheetFunction.CountIf(oDat, oCelC.Value) = 0 Then oCelC.Interior.ColorIndex = 6
Next oCelC
End With
Application.ScreenUpdating = True
End Sub[/COLOR]
qui est un hybride de la proposition de skoobi et de la mienne. (WorksheetFunction.CountIf étant ici meilleur que Find : je dis bien ici, car Find est une fonction paramétrée puissante qui n'est pas à négliger. Mais s'agissant d'un simple comptage, on n'utilise pas les avantages de sa puissance tout en ayant les inconvénients de sa lourdeur.)
Les résultats sont un peu meilleurs que ceux obtenus par pierrejean (gain de l'ordre de 15% en moyenne).
En fait, on s'aperçoit que ceux qui ont fait des tests obtiennent des résultats différents les uns des autres. Par exemple, dans aucun de mes tests ma proposition n'est plus rapide que celle de pierrejean, alors qu'il a parfois observé le contraire. La structure des données des deux tables peut expliquer ces divergences. Le cas est évident pour la méthode utilisant "UNION" : s'il y a très peu ou beaucoup de données nouvelles dans la deuxième table, cette méthode est très rapide (la plus rapide quelquefois).
Par contre si il y a environ 50 % de données nouvelles, on peut avoir le pire et le meilleur.
J'ai testé sur 10206 données dont 5103 sont nouvelles. Si toutes les données nouvelles sont groupées : 0,7 secondes. Si les données nouvelles alternent avec les données anciennes : 2 minutes 20 secondes. Dans les deux cas, la procédure de pierrejean donne 2,1 secondes.
J'en déduit que la plage obtenue avec "UNION" est très difficilement gérée lorsqu'elle est très morcelée. J'attends avec intérêt les analyses des autres testeurs...
debut = Timer
Range("C4:C65536").Interior.ColorIndex = xlNone
Application.ScreenUpdating = False
references = Range("A4:A" & Range("A65536").End(xlUp).Row)
Liste = Range("C4:C" & Range("C65536").End(xlUp).Row)
ldeb = 3
col = 3
For n = LBound(Liste, 1) To UBound(Liste, 1)
For m = LBound(references, 1) To UBound(references, 1)
If Liste(n, 1) = references(m, 1) Then
exist = True
[COLOR=blue]Exit For[/COLOR]
End If
Next m
If exist = False Then Cells(ldeb + n, col).Interior.ColorIndex = 6
exist = False
Next n
Application.ScreenUpdating = True
MsgBox (Timer - debut)
End Sub
Qui me permet d'avoir dans les mêmes conditions de test 8s au lieu de 33s
Je teste la derniere proposition de ROGER
Edit : dans mes conditions de test ROGER arrive a 6s c'est donc le TOP
Il est vrai que ces conditions sont irrealistes (je n'ais fait que recopier les listes initiales ce qui fait que pour la liste des référencés elle n'est pratiquement pas parcourue en entier lorsqu'il y a identité)
Comme ROGER j'attends de nouveaux tests
NB: J'ai testé la macro avec UNION en remplaçant le range par un tableau sans obtenir la moindre acceleration
5000 fournisseurs differents référencés
10000 listés dont 1250 non référencés
Palmares: ROGER 3sec
Union: 6 sec
Pierrejean: 9 sec
pour ceux qui seraient interessés voici les macros fabriquant les listes
Code:
Sub faire_liste1()
Range("A4:A65536").ClearContents
For n = 4 To 5003
Range("A" & n) = "Fournisseur " & n - 3
Next n
End Sub
Sub faire_liste2()
nb = 1
Range("C4:C65536").ClearContents
For n = 4 To 5003
Range("C" & n) = "Fournisseur " & n - 3
If n Mod 4 = 0 Then
Range("C" & n) = "Nouveau" & nb
nb = nb + 1
End If
Next n
For n = 5004 To 10003
Range("C" & n) = "Fournisseur " & n - 5003
Next n
End Sub
je regarde pour inclure plus de non référencés
edit: Avec cette fois 2500 non référencés
ROGER: 3sec
Pierrejean 10sec
Union: 26 sec
ce qui confirme la grande sensibilité de l'Union aux listes a traiter
avec les conditions de Pierrejean (j'ai utilisé son code pour créer les listes) :
0.4 s (avec xl2007)
Code:
Sub je_peux_jouer() 'Hub
Dim MesFrn As Object, MesFrn2 As Object
Dim Cel As Object
Dim C
Set MesFrn = CreateObject("Scripting.Dictionary")
Set MesFrn2 = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
t = Timer
Columns(3).Interior.ColorIndex = xlNone
For Each Cel In Range("A4:A" & [A65000].End(xlUp).Row)
MesFrn.Item(Cel.Value) = Cel.Value
Next Cel
For Each Cel In Range("C4:C" & [C65000].End(xlUp).Row)
If Not MesFrn.Exists(Cel.Value) Then MesFrn2.Item(Cel.Value) = Cel.Row
Next Cel
If MesFrn2.Count > 0 Then
For Each C In MesFrn2.items
Cells(C, 3).Interior.ColorIndex = 6
Next C
End If
Application.ScreenUpdating = True
MsgBox Timer - t
End Sub
PS, ici l'été arrive à grands pas, ça devient de plus en plus chaud...
Elle n'offre pas de performances supérieures à la plupart des autres propositions.
La meilleur synthèse que j'ai testée est
Code:
[COLOR=darkslategray]Sub FrsNonRéférencé2() 'Roger[/COLOR]
[COLOR=darkslategray]Dim oCelC As Range, oDat[/COLOR]
[COLOR=darkslategray]Application.ScreenUpdating = False[/COLOR]
[COLOR=darkslategray]Set oDat = Worksheets("Feuil1").Range("A4:" & Range("A4").End(xlDown).Address)[/COLOR]
[COLOR=darkslategray]With Worksheets("Feuil1").Range("C4:" & Range("C4").End(xlDown).Address)[/COLOR]
[COLOR=darkslategray].Interior.ColorIndex = xlNone[/COLOR]
[COLOR=darkslategray]For Each oCelC In .Cells[/COLOR]
[COLOR=darkslategray] If WorksheetFunction.CountIf(oDat, oCelC.Value) = 0 Then oCelC.Interior.ColorIndex = 6[/COLOR]
[COLOR=darkslategray]Next oCelC[/COLOR]
[COLOR=darkslategray]End With[/COLOR]
[COLOR=darkslategray]Application.ScreenUpdating = True[/COLOR]
[COLOR=darkslategray]End Sub[/COLOR]
qui est un hybride de la proposition de skoobi et de la mienne. (WorksheetFunction.CountIf étant ici meilleur que Find : je dis bien ici, car Find est une fonction paramétrée puissante qui n'est pas à négliger. Mais s'agissant d'un simple comptage, on n'utilise pas les avantages de sa puissance tout en ayant les inconvénients de sa lourdeur.)
Les résultats sont un peu meilleurs que ceux obtenus par pierrejean (gain de l'ordre de 15% en moyenne).
En fait, on s'aperçoit que ceux qui ont fait des tests obtiennent des résultats différents les uns des autres. Par exemple, dans aucun de mes tests ma proposition n'est plus rapide que celle de pierrejean, alors qu'il a parfois observé le contraire. La structure des données des deux tables peut expliquer ces divergences. Le cas est évident pour la méthode utilisant "UNION" : s'il y a très peu ou beaucoup de données nouvelles dans la deuxième table, cette méthode est très rapide (la plus rapide quelquefois).
Par contre si il y a environ 50 % de données nouvelles, on peut avoir le pire et le meilleur.
J'ai testé sur 10206 données dont 5103 sont nouvelles. Si toutes les données nouvelles sont groupées : 0,7 secondes. Si les données nouvelles alternent avec les données anciennes : 2 minutes 20 secondes. Dans les deux cas, la procédure de pierrejean donne 2,1 secondes.
J'en déduit que la plage obtenue avec "UNION" est très difficilement gérée lorsqu'elle est très morcelée. J'attends avec intérêt les analyses des autres testeurs...
Pour ce qui est de Union, je pense qu'il faut le "vider" de tant en temps par "paquet", et ça accélère le résultat.
En reprenant le code de bhbh, dictionary est très rapide, ça donne ceci:
Code:
Sub je_peux_jouer() 'Hub
Dim MesFrn As Object, MesFrn2 As Object
Dim Cel As Object, Plage As Range
Dim C
t = Timer
Set MesFrn = CreateObject("Scripting.Dictionary")
Set MesFrn2 = CreateObject("Scripting.Dictionary")
Set Plage = [C3]
Application.ScreenUpdating = False
Columns(3).Interior.ColorIndex = xlNone
For Each Cel In Range("A4:A" & [A65000].End(xlUp).Row)
MesFrn.Item(Cel.Value) = Cel.Value
Next Cel
For Each Cel In Range("C4:C" & [C65000].End(xlUp).Row)
If Not MesFrn.Exists(Cel.Value) Then MesFrn2.Item(Cel.Row) = Cel.Row
Next Cel
If MesFrn2.Count > 0 Then
For Each C In MesFrn2.items
Set Plage = Union(Plage, Cells(C, 3))
If Plage.Count = 20 Then
Plage.Interior.ColorIndex = 6
Set Plage = [C3]
End If
' Cells(C, 3).Interior.ColorIndex = 6
Next C
End If
'pour traiter les éventuelles cellules à la fin de la liste
Plage.Interior.ColorIndex = 6
Application.ScreenUpdating = True
Debug.Print Timer - t
End Sub
'paquet de 10: 1.29s
'paquet de 20: 1.21s
paquet de 10: 1.29s
paquet de 20: 1.21s
"classique": 2.37s
Edit: A partir d'un paquet de 100, le temps ce rallonge à nouveau.
Ah oui, petite précision: colonne A 10000 refs, colonne C 30000
Très rapide, en effet. Mais fait autre chose que les autres procédures : seule la dernière occurrence d'une référence nouvelle est sélectionnée. (Pas grave si on est certain d'avoir une liste sans doublon, et même bénéfique s'il s'agit de découvrir la liste des nouvelles entrées sans s'occuper des éventuels doublons.)
En remplaçant
Code:
[COLOR="DarkSlateGray"] If Not MesFrn.Exists(Cel.Value) Then MesFrn2.Item(Cel.Value) = Cel.Row[/COLOR]
par
Code:
[COLOR="DarkSlateGray"] If Not MesFrn.Exists(Cel.Value) Then MesFrn2.Item(Cel.Value) = Cel.Row[COLOR="DarkOrange"]: MesFrn2.Key(Cel.Value) = Cel.Row[/COLOR][/COLOR]
on arrive au même résultat qu'avec les autres procédures, avec un temps du même ordre, voire très légèrement plus court. A tester sur des cas différents : c'est peut-être la solution la plus rapide. _ Remarque pour les puristes : avec
Arff moi les Timer , je suis pas (comme indiqué plus haut )très fort donc
dans un premier temps j'ai modifié la macro revu par Roger ,on gagne un peu de temps
où je teste les données , non présentent plutôt que les présentent
Code:
Sub Test3Chti160()
Dim TabF1 As Variant
Dim TabF2 As Variant
Dim L1 As Long
Dim L2 As Long
Dim Coll_Fourn As Collection
Dim debut
Application.ScreenUpdating = False
Set Coll_Fourn = New Collection
On Error Resume Next
debut = Timer
With Worksheets("Feuil1")
TabF1 = .Range(.Cells(4, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)).Value
With .Range(.Cells(4, 3), .Cells(.Cells(.Rows.Count, 3).End(xlUp).Row, 3))
TabF2 = .Value
[COLOR=Red].Interior.ColorIndex = xlNone[/COLOR] '[COLOR=DarkGreen]on efface la mise en forme[/COLOR]
End With
For L1 = 1 To UBound(TabF1, 1)
Coll_Fourn.Add TabF1(L1, 1), CStr(TabF1(L1, 1))
Next L1
For L2 = 1 To UBound(TabF2, 1)
Coll_Fourn.Add TabF2(L2, 1), CStr(TabF2(L2, 1))
'[COLOR=DarkGreen]ci dessous on colore si Non présente[/COLOR]
If [COLOR=Red]Err.Number = 0[/COLOR] Then .Cells(L2 + 3, 3).Interior.ColorIndex = [COLOR=Red]6[/COLOR]
Err.Clear
Next L2
.Cells(4, 9) = (Timer - debut)
End With
Application.ScreenUpdating = True
End Sub
j'ai utilisé pour des raisons de poids et de tests les procédures de pierrejean pour créer les listes
ensuite j'ai ajouté ce que j'ai cru comprendre de l'utilisation de Timer lol
et ensuite on teste via les boutons sans oublier de créer les 2 listes bien sur.
tenez moi au courant des tests lol
je n'ai toujours pas retrouvé le fichier de Ti
Ps : je viens de voir le fil de bhbh et effectivement , c'est l'ordre de grandeur que j'obtiens avec Excel 2007 et les deux procédures que j'utilise( avec ou sans Récup de la liste)
Bonne journée
ps voila ce que j'obtient en testant avec en plus la procédure de bhbh
Roger------ Pierrejean---Chti160 sans recup Liste-- Avec Recup Liste---- bhbh
14,09375-- 18,390625-- 0,296875------------------0,3125------------- 0,375
en reprenant le code de création des listes de PierreJean, avec l'utilisation de dictionary combiné à Union par "paquet de 30" j'obtiens:
Gère aussi les doublons.
'paquet de 30: 0.4s
'classique: 0.57s
Code:
Sub je_peux_jouer() 'Hub
Dim MesFrn As Object, MesFrn2 As Object
Dim Cel As Object, Plage As Range
Dim C
t = Timer
Set MesFrn = CreateObject("Scripting.Dictionary")
Set MesFrn2 = CreateObject("Scripting.Dictionary")
Set Plage = [C3]
Application.ScreenUpdating = False
Columns(3).Interior.ColorIndex = xlNone
For Each Cel In Range("A4:A" & [A65000].End(xlUp).Row)
MesFrn.Item(Cel.Value) = Cel.Value
Next Cel
For Each Cel In Range("C4:C" & [C65000].End(xlUp).Row)
If Not MesFrn.Exists(Cel.Value) Then MesFrn2.Item(Cel.Row) = Cel.Row
Next Cel
If MesFrn2.Count > 0 Then
For Each C In MesFrn2.items
Set Plage = Union(Plage, Cells(C, 3))
If Plage.Count = 30 Then
Plage.Interior.ColorIndex = 6
Set Plage = [C3]
End If
' Cells(C, 3).Interior.ColorIndex = 6
Next C
End If
'pour traiter les éventuelles cellules à la fin de la liste
Plage.Interior.ColorIndex = 6
Application.ScreenUpdating = True
Debug.Print Timer - t
'paquet de 30: 0.4s
'classique: 0.57s
Sub faire_liste1()
Range("A4:A65536").ClearContents
For n = 4 To 5003
Range("A" & n) = "Fournisseur " & n - 3
Next n
End Sub
Sub faire_liste2()
nb = 1
Range("C4:C65536").ClearContents
For n = 4 To 5003
Range("C" & n) = "Fournisseur " & n - 3
If n Mod 4 = 0 Then
Range("C" & n) = "Nouveau" & nb
nb = nb + 1
End If
Next n
For n = 5004 To 10003
Range("C" & n) = "Fournisseur " & n - 5003
If n Mod 4 = 0 Then
Range("C" & n) = "Nouveau" & nb
nb = nb + 1
End If
Next n
End Sub