Discussion :

[le_dabbabi]

Bonjour a tous

Mon problème c'est que j'ai un tableau qui contient plusieurs valeurs ( vers 10000 lignes ) , mon objectif c'est de chercher des valeurs ( que je vais les inserts ) dans ce tableau et les copier dans une autre feuille.
Ma macro fonctionne très bien mais le soucie qu'elle prend beaucoup de temps d’exécution ( elle dépasse les 30 min des fois )

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
Sub detecter_packet_saisi()
 
 
Sheets("Quantité produite").Select
Range("A2:t70000").Select
   Selection.ClearContents
 
 
 
 
 
 
With ActiveWorkbook.Worksheets("tableau zbox")
 
 
 dlf2 = 2
 For i = 1 To Worksheets("tableau zbox").Cells(1, 1).End(xlDown).Row 'derniere cellule renseignée de la colonne, nécessite que toutes les cellules soient remplies
 
  For j = 1 To Worksheets("tableau zbox").Cells(1, 1).End(xlDown).Row
 
    If Worksheets("tableau zbox").Cells(j, 2) = Worksheets("tableau zbox").Cells(i, 10) Then
 
Worksheets("Quantité produite").Cells(dlf2, 1).Value = Worksheets("tableau zbox").Cells(j, 1).Value
Worksheets("Quantité produite").Cells(dlf2, 2).Value = Worksheets("tableau zbox").Cells(j, 2).Value
Worksheets("Quantité produite").Cells(dlf2, 3).Value = Worksheets("tableau zbox").Cells(j, 3).Value
Worksheets("Quantité produite").Cells(dlf2, 4).Value = Worksheets("tableau zbox").Cells(j, 4).Value
Worksheets("Quantité produite").Cells(dlf2, 5).Value = Worksheets("tableau zbox").Cells(j, 5).Value
Worksheets("Quantité produite").Cells(dlf2, 6).Value = Worksheets("tableau zbox").Cells(j, 6).Value
Worksheets("Quantité produite").Cells(dlf2, 7).Value = Right(Worksheets("tableau zbox").Cells(j, 4).Value, 3)
 dlf2 = dlf2 + 1
    End If
  Next j
  Next i
Sheets("Quantité produite").Select
 
 
 
    End With
End Sub

Je compte sur votre aide , Merci d'avance

[BENNASR]

bonjour
je comprends pas bien la demande...peux tu expliquer davantage à l'aide d'un capture écran des données de départ et si vraiment nécessaire merci de joindre un fichier test avec qq données non confidentielles
En général, il faut remplacer les deux boucles imbriqués par un filtre

[MarcelG]

Bonjour,

Tout d'abord, il te faut supprimer ces f... Select, qui ne sont d'aucune utilité..
Ensuite, rattacher les objets Range à leur feuille parent me paraît, surtout ici, opportun.
Enfin, tu peux désactiver la mise à jour de l'écran, durant l'exécution de la procédure. (Je te laisse traduire)

Ayant un nombre conséquent de lignes à tester, il peut paraître logique d'avoir un temps d'exécution assez long.
Dans le cas présent, l'utilisation de la méthode Find semble adéquat.
Tu n'aurais ainsi qu'un seul balayage à effectuer.
Pour ce faire, consulte l'exemple retourné dans l'espace documentaire indiqué.

[le_dabbabi]

Merci pour vos réponse vous trouverez ci-joint un fichier test. ( feuille tableau Zbox , Bouton paquets saisies )

[MarcelG]

Salut,

Euh, non! Pour ma part.
Généralement, sur ce Forum, les classeurs en pièce jointe ne sont pas ouverts en début de discussion.
Reporte le code utilisé et précise la(les) difficulté(s).

[BENNASR]

bonsoir
pas besoins de 2 boucles
à tester (chez moi le taf prends 100 secondes pour données de 15000 lignes)

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
Sub detecter_packet_saisi()
Dim derlig As Long
Dim L As Integer
Dim F1 As Worksheet
Dim F2 As Worksheet
Set F1 = Worksheets("tableau zbox")
Set F2 = Sheets("Quantité produite")
Dim start As Single
Dim RunTime As Single
Application.ScreenUpdating = False
start = Timer
F2.Range("A2:t" & F2.Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
 dlf2 = 2
 derlig = F1.Cells(Rows.Count, 1).End(xlUp).Row
 With F1.Range("B2:B" & derlig)
 For L = 2 To derlig
Set c = .Find(F1.Cells(L, 10), LookIn:=xlValues)
If Not c Is Nothing Then
F2.Cells(dlf2, 1).Value = F1.Cells(c.Row, 1)
F2.Cells(dlf2, 2).Value = F1.Cells(c.Row, 2)
F2.Cells(dlf2, 3).Value = F1.Cells(c.Row, 3)
F2.Cells(dlf2, 4).Value = F1.Cells(c.Row, 4)
F2.Cells(dlf2, 5).Value = F1.Cells(c.Row, 5)
F2.Cells(dlf2, 6).Value = F1.Cells(c.Row, 6)
F2.Cells(dlf2, 7).Value = Right(F1.Cells(c.Row, 4), 3)
dlf2 = dlf2 + 1
End If
Next L
End With
 Application.ScreenUpdating = True
 Sheets("Quantité produite").Select
  RunTime = Timer - start
    RunTime = Format(RunTime, "0.000")
    MsgBox ("Rapport enregistré dans: " & RunTime & " secondes")
End Sub

[le_dabbabi]

Merci ça fonctionne très bien maintenant ça me prend 15s