Problème temps d'exécution sur l'utilisation d'un recordset et la recherche de données

**juju05** · 21/12/2011, 15h26

Bonjour,

Je suis débutant en vba excel.
Pour chaque ligne du recordset, je dois rechercher si un champ est présent dans une colonne. Si tel est le cas, je passe à l'enregistrement suivant sinon j'écris l'enregistrement sur la première ligne disponible en bas de mon tableau.
Le temps d'exécution est beaucoup trop long.
Voici ma requête :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
 Dim conn As New ADODB.Connection
   Dim connString
   Dim rsRecords As New ADODB.Recordset
   Dim num_wo As String
   Dim rFound As Range
 
   ' non trouvé alors 0 sinon 1
   Dim trouve As Integer
 
      Dim lastlig1 As Integer  
 
   ' N° de ligne à insèrer dans la feuille 1    Dim num_ligne As Integer
 
   ' Détermination de la dernière ligne de la feuille 1 (Prépa. palette)
   Worksheets("Prepa palette").Activate
   With Worksheets("Prepa palette")
        lastlig1 = .Cells(.Rows.Count, "E").End(xlUp).Row
        num_ligne = lastlig1
   End With      
 
   ' Connexion à la base de données
   connString = "DSN=TOP;Uid=TOPMAN01;Pwd=TOPMAN01"
   conn.Open connString
 
   rsRecords.CursorLocation = adUseServer
 
   rsRecords.Open "select distinct(wo.num_wo), c.raison_sociale, a.designation, a.reference, wo.qty_total, wo.due_end from  toperp.t_client c right outer join toperp.t_article a on a.id_client = c.id_client inner join topmes.wo wo on a.id_article = wo.id_article inner join topmes.wo_op wop on wo.id_wo = wop.id_wo inner join topmes.wo_instruction wi on wop.id_wo_instruction = wi.id_wo_instruction inner join topmes.wo_resource wr on wi.id_wo_instruction = wr.id_wo_instruction inner join toppdm.resource_tree_item rt  on  wr.id_resource = rt.id_resource   inner join topsys.department d on rt.id_parent_origin = d.id_department where wo.qty_total > 0 and wo.due_end Is Not Null and wo.due_end  >= TO_DATE('01/01/2011','DD/MM/YYYY') and (wo.b_closed is null or wo.b_closed = 0) and wop.id_wo_op not in (select w.id_wo_op from topmes.wip w where w.id_wo_op is not null ) and d.id_department = 1441 ", conn, adOpenForwardOnly, adLockReadOnly
 
   If conn.State = adStateOpen Then
 
      ' Lecture du premier enregistrement
      rsRecords.MoveFirst
      While Not rsRecords.EOF
 
        ' Récupération du numéro d'O.F.
        num_wo = rsRecords.Fields("num_wo").Value
 
        ' Initialisation à non trouvé
        trouve = 0      
 
        With Worksheets("Prepa palette")
             Set rFound = .Range("E3:E" & lastlig1).Find(num_wo, LookIn:=xlValues)
             ' Si trouvé
             If Not rFound Is Nothing Then
                trouve = 1
             End If
        End With                  
 
               If trouve = 0 Then
 
                num_ligne = num_ligne + 1
 
                Range("A" & num_ligne).Value = rsRecords.Fields("raison_sociale").Value
                Range("B" & num_ligne).Value = rsRecords.Fields("designation").Value
                Range("C" & num_ligne).Value = rsRecords.Fields("reference").Value
                Range("D" & num_ligne).Value = rsRecords.Fields("qty_total").Value
                Range("E" & num_ligne).Value = num_wo
                Range("F" & num_ligne).Value = rsRecords.Fields("due_end").Value
                Range("K" & num_ligne).Value = "x"
 
        End If
 
        ' Lecture de l'enregistrement suivant
        rsRecords.MoveNext
      Wend
 
      Worksheets("Prepa palette").Activate
 
   Else
     ' Problème de connexion
     MsgBox "no connection"
   End If
 
   ' Repositionnement sur la cellule A1
   Range("A1").Select
   MsgBox "Import terminé !"
 
   rsRecords.Close
   Set rsRecords = Nothing
   conn.Close
   Set conn = Nothing

Je vous remercie d'avance.
Julien.

**ZebreLoup** · 21/12/2011, 15h51

Je te conseillerais d'enregistrer au préalable les éléments de ta feuille dans un dictionnaire et d'ensuite utiliser la fonction Exists, ce sera beaucoup plus rapide que d'aller faire à chaque fois un Find sur la feuille. Dis-moi si tu as besoin d'explications plus détaillées.

Une autre idée serait d'intégrer les données de ta feuille dans une table temporaire dans ta base et d'ensuite adapter ta requête pour ne récupérer directement que les enregistrements à ajouter. Mais ce n'est pas forcément idéal de toucher à la base.

**jfontaine** · 21/12/2011, 15h57

Bonjour,

Une autre approche sans changer de méthode

Désactive les calculs et le rafraîchissementde l'écran

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
 
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
 
... code
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

**ZebreLoup** · 21/12/2011, 16h13

Oui bien sûr, essaie d'abord l'astuce de jfontaine, ça t'évitera de revoir ton code si cette modification suffit...
(Je n'y pense pas quand ce n'est pas mon fichier que je vois clignoter dans tous les sens devant mes yeux !

)