Macro qui tourne pendant très longtemps

Machapi

XLDnaute Nouveau
Bonjour,

J'ai crée un petit code VBA qui a l'objectif suivant :

J'ai une liste de références sur une feuille, je compare ses références avec celles présentes sur une autre feuille. Si les références sont égales je veux écrire la quantité adequouat dans la première feuille.

Ca donne ca :
Code:
Sub prendre()

Dim i As Integer
Dim j As Integer

For i = 2 To 5050
For j = 2 To 3250
    If Sheets("bon").Cells(i, 1).Value = Sheets("donnee").Cells(j, 1).Value Then
    Sheets("donnee").Cells(j, 2).Copy Sheets("bon").Cells(i, 2)
    End If
 Next
 Next


End Sub

Voilà la marco met vraiment beaucoup de temps à se réaliser (plus de 5 minutes). Comment puis-je l'améliorer ?
 

pierrejean

XLDnaute Barbatruc
Re : Macro qui tourne pendant très longtemps

Bonjour Machapi

A tester:

Code:
Sub test()
tablo1 = Sheets("bon").Range("A2:B5050")
tablo2 = Sheets("donnee").Range("A2:B3250")
For n = LBound(tablo1, 1) To UBound(tablo1, 1)
 For m = LBound(tablo2, 1) To UBound(tablo2, 1)
   If tablo1(n, 1) = tablo2(m, 1) Then
     tablo2(m, 2) = tablo1(n, 2)
   End If
 Next
Next
Sheets("donnee").Range("A2").Resize(UBound(tablo2, 1), UBound(tablo2, 2)) = tablo2
End Sub
 

Papou-net

XLDnaute Barbatruc
Re : Macro qui tourne pendant très longtemps

Bonjour Machapi, PierreJean,

C'est sans garantie, mais puisque je l'ai élaborée je propose une autre solution qui devrait quand même accélérer un peu le processus:

Code:
Sub prendre()

Dim i As Integer
Dim Cel As Range

For i = 2 To 5050
  Set Cel = Sheets("donnee").Range("A2:A3250").Find(Sheets("bon").Cells(i, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
  If Not Cel Is Nothing Then Cel.Copy Sheets("bon").Cells(i, 2)
Next
End Sub
Mais il est vrai que la solution manipulant des tableaux devrait être bien plus rapide.

A +

Cordialement.
 

Discussions similaires

Réponses
11
Affichages
296