VBA : fonction Find

Excel-lent · 28 Octobre 2009

Bonjour à tous,

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)?

Merci d'avance pour votre aide.

Cordialement

skoobi · 28 Octobre 2009

Re : VBA : fonction Find

ROGER2327 à dit:
Re...
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.)

ROGER2327
#2002

J'ai aussi déjà fait ce constat par le passé sans trouver de réponse...

Excel-lent · 28 Octobre 2009

Re : VBA : fonction Find

Hello,

skoobi à dit:
Encore un grand merci à tous, et tout particulièrement à JeanPierre qui fut le plus rapide.

Cliquez pour agrandir...

Tellement rapide que je ne le vois pas dans la discussion .

Je ne vous ai pas dit? Je me suis mis au Verlan.

Il ne fallait pas lire JeanPierre mais PierreJean

(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

Bonne soirée à tous

soenda · 28 Octobre 2009

Re : VBA : fonction Find

Re,

@Roger et pierrejean

J'ai effectué deux tests avec une liste de 5 000 fournisseurs référencés:

- Un avec une liste à analyser de 5 000 items, qui confirme mes premiers résultats.

- Et un avec une liste à analyser de 10 000 items, qui vous donne grandement raison. Voir PJ

Sans vous je n'aurais pas vu ce problème.

Merci à vous deux

A plus

Edition : et à skoobi, dont je n'avais pas vu la remarque

ChTi160 · 28 Octobre 2009

Re : VBA : fonction Find

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

Le Fichier : http://cjoint.com/?kCwv0YtFCF

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

ROGER2327 · 29 Octobre 2009

Re : VBA : fonction Find

Bonsoir à tous

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...

A bientôt.
ROGER2327
#2005

pierrejean · 29 Octobre 2009

Re : VBA : fonction Find

Re

Salut mon ami Chti

Salut a tous

Une amelioration sensible de ma macro:

Code:

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

pierrejean · 29 Octobre 2009

Re : VBA : fonction Find

Re

Nouveaux tests plus réalistes

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

Cousinhub · 29 Octobre 2009

Re : VBA : fonction Find

Bonsoir,

Bonsoir de nouméa à tout le monde...

Je peux jouer?

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...

Bonne journée

skoobi · 29 Octobre 2009

Re : VBA : fonction Find

Salut Hubert

, bonjour les amis

,

Alors Hubert, ça va le bronzage?

.

Arfff, tu m'a piqué l'idée du "dictionary"

.

skoobi · 29 Octobre 2009

Re : VBA : fonction Find

Re,

ROGER2327 à dit:
Bonsoir à tous

Intéressant, tout ça... La dernière proposition (ChTi160) adaptée aux conditions du problème donne :

Code:

[COLOR=darkslategray]Option Base 1[/COLOR] [COLOR=darkslategray]Sub Test2()[/COLOR] [COLOR=darkslategray]Dim TabF1 As Variant[/COLOR] [COLOR=darkslategray]Dim TabF2 As Variant[/COLOR] [COLOR=darkslategray]Dim L1 As Long[/COLOR] [COLOR=darkslategray]Dim L2 As Long[/COLOR] [COLOR=darkslategray]Dim Coll_Fourn As Collection[/COLOR] [COLOR=darkslategray]Application.ScreenUpdating = False[/COLOR] [COLOR=darkslategray]Set Coll_Fourn = New Collection[/COLOR] [COLOR=darkslategray]On Error Resume Next[/COLOR] [COLOR=darkslategray]With Worksheets("Feuil1")[/COLOR] [COLOR=darkslategray]TabF1 = .Range(.Cells(4, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)).Value[/COLOR] [COLOR=darkslategray]With .Range(.Cells(4, 3), .Cells(.Cells(.Rows.Count, 3).End(xlUp).Row, 3))[/COLOR] [COLOR=darkslategray] TabF2 = .Value[/COLOR] [COLOR=darkslategray] .Interior.ColorIndex = 6[/COLOR] [COLOR=darkslategray]End With[/COLOR] [COLOR=darkslategray]For L1 = 1 To UBound(TabF1, 1)[/COLOR] [COLOR=darkslategray] Coll_Fourn.Add TabF1(L1, 1), CStr(TabF1(L1, 1))[/COLOR] [COLOR=darkslategray]Next L1[/COLOR] [COLOR=darkslategray]For L2 = 1 To UBound(TabF2, 1)[/COLOR] [COLOR=darkslategray] Coll_Fourn.Add TabF2(L2, 1), CStr(TabF2(L2, 1))[/COLOR] [COLOR=darkslategray] If Err.Number Then .Cells(L2 + 3, 3).Interior.ColorIndex = xlNone[/COLOR] [COLOR=darkslategray] Err.Clear[/COLOR] [COLOR=darkslategray]Next L2[/COLOR] [COLOR=darkslategray]End With[/COLOR] [COLOR=darkslategray]Application.ScreenUpdating = True[/COLOR] [COLOR=darkslategray]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[/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...

A bientôt.
ROGER2327
#2005

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

ROGER2327 · 29 Octobre 2009

Re : VBA : fonction Find

Bonjour à tous, bonjour bhbh

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

Code:

[SIZE="2"][COLOR="DarkSlateGray"]Set MesFrn = CreateObject("[COLOR="DarkOrange"]Scripting[/COLOR].Dictionary")
[/COLOR][/SIZE]

on sort de VBA pur et dur en appelant une application externe.

ROGER2327
#2009

ChTi160 · 29 Octobre 2009

Re : VBA : fonction Find

Bonjour le Fil
Bonjour le Forum

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

Le Fichier : http://cjoint.com/?kDlt4Zacp3

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

MJ13 · 29 Octobre 2009

Re : VBA : fonction Find

Bonjour à tous

Alors la vous m'épatez avec tous vos codes

.

Je suis pas encore tableau, mais il va falloir que je m'y mette.

On frise le fondamental, il faudrait le transmettre à Charly88.

skoobi · 29 Octobre 2009

Re : VBA : fonction Find

Encore moi,

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

pierrejean · 29 Octobre 2009

Re : VBA : fonction Find

Re

Nouveaux codes de création de liste

On obtient generalement des temps differents

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
 If n Mod 4 = 0 Then
 Range("C" & n) = "Nouveau" & nb
 nb = nb + 1
 End If
Next n
End Sub

VBA : fonction Find

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Accro

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Partager cette page

Statistiques des forums