Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel vitesse d'execution (optimiser)

vitesse d'execution (optimiser)

4 réponses
Avatar
ced
Bonjour à tous,
Dans l'une de mes macros je compare 3 feuilles deux à deux, ie feuille 1
avec feuille 2 et feuille 1 avec feuille 3, sachant que feuille 1 à une
liste de 1000 lignes environ, feuille 2 : 12000 lignes et feuille 3 : 300
lignes. Mon problème est lié à la durée d'execution de chacune des 2 macros,
ComPO1 dure pret de 14 minutes et ComPO2 environ 18 minutes (sur un P4).
Auriez-vous une solution à me proposer afin d'optimiser l'execution de ces 2
macros.
Merci du temps que vous me consacrer
A++ ;-)

Sub ComPO1()
Application.ScreenUpdating = False
Dim Cellule1 As Range, Cellule2 As Range
Sheets("feuil1").Activate
For Each Cellule1 In Range("h:h")
Sheets("feuil2").Activate
For Each Cellule2 In Range("d:d")
If Cellule1 = Cellule2 Then
Cellule1.Offset(0, 7) = Cellule2.Offset(0, -1)
Exit For
End If
Next Cellule2
Next Cellule1
Application.ScreenUpdating = true
Call ComPO2
End Sub

Sub ComPO2()
Application.ScreenUpdating = False
Dim Cellule1 As Range, Cellule2 As Range
Sheets("feuil1").Activate
For Each Cellule1 In Range("h:h")
Sheets("feuil3").Activate
For Each Cellule2 In Range("c:c")
If Cellule1 = Cellule2 Then
Cellule1.Offset(0, 8) = Cellule2.Offset(0, 2)
Cellule2.Offset(0, 4).FormulaR1C1 = "x"
Exit For
End If
Next Cellule2
Next Cellule1
Application.ScreenUpdating = true
End Sub
Signaler un problème avec ce contenu

4 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
AV
Pour aller nettement plus vite, ça pourrait avoir cette allure là (à adapter)

Sub zzzz()
plg_F1 = "Feuil1!" & Sheets("Feuil1").Range("H1",
Sheets("Feuil1").[H65536].End(3)).Address
plg_F2 = "Feuil2!" & Sheets("Feuil2").Range("D1",
Sheets("Feuil2").[D65536].End(3)).Address
plg_F3 = "Feuil3!" & Sheets("Feuil3").Range("C1",
Sheets("Feuil3").[C65536].End(3)).Address

For Each c In Range(plg_F1)
If Not Application.Range(plg_F2).Find(c.Value, LookAt:=xlWhole) _
Is Nothing Then ' ...traitement pour valeur trouvée en Feuil1 et Feuil2
Next
If Not Application.Range(plg_F3).Find(c.Value, LookAt:=xlWhole) _
Is Nothing Then ' ...traitement pour valeur trouvée en Feuil1 et Feuil3
Next
End Sub

AV
Avatar
Rai
"ced" a écrit dans le message de news:
Bonjour à tous,
Dans l'une de mes macros je compare 3 feuilles deux à deux, ie feuille 1
avec feuille 2 et feuille 1 avec feuille 3, sachant que feuille 1 à une
liste de 1000 lignes environ, feuille 2 : 12000 lignes et feuille 3 : 300
lignes. Mon problème est lié à la durée d'execution de chacune des 2 macros,
ComPO1 dure pret de 14 minutes et ComPO2 environ 18 minutes (sur un P4).
Auriez-vous une solution à me proposer afin d'optimiser l'execution de ces 2
macros.
Merci du temps que vous me consacrer
A++ ;-)

Sub ComPO1()
Application.ScreenUpdating = False
Dim Cellule1 As Range, Cellule2 As Range
Sheets("feuil1").Activate
For Each Cellule1 In Range("h:h")
Sheets("feuil2").Activate
For Each Cellule2 In Range("d:d")
If Cellule1 = Cellule2 Then
Cellule1.Offset(0, 7) = Cellule2.Offset(0, -1)
Exit For
End If
Next Cellule2
Next Cellule1
Application.ScreenUpdating = true
Call ComPO2
End Sub

Sub ComPO2()
Application.ScreenUpdating = False
Dim Cellule1 As Range, Cellule2 As Range
Sheets("feuil1").Activate
For Each Cellule1 In Range("h:h")
Sheets("feuil3").Activate
For Each Cellule2 In Range("c:c")
If Cellule1 = Cellule2 Then
Cellule1.Offset(0, 8) = Cellule2.Offset(0, 2)
Cellule2.Offset(0, 4).FormulaR1C1 = "x"
Exit For
End If
Next Cellule2
Next Cellule1
Application.ScreenUpdating = true
End Sub



Bonsoir,

En premier, puisque tu as une idée du nombre de lignes à traiter :
- environ 1000 pour feuil1
- environ 300 pour feuill2
- ...

Tu peux déjà restreindre le traitement à ces lignes (avec un petit rabiot si tu veux.
Inutile d'utiliser .range("c:c") qui traite toute la colonne (soit 65536 lignes au lieu de 300 !)
Lui préférer .range("c1:c400")

Ensuite, plutôt que d'activer les sheets à chaque traitement, adresse les directement.

Ta macro ComPO2 deviendrait :

Sub ComPO2()
Application.ScreenUpdating = False
Dim Cellule1 As Range, Cellule2 As Range
For Each Cellule1 In Sheets("feuil1").Range("h1:h1200")
For Each Cellule2 In Sheets("feuil3").Range("c1:c400")
If Cellule1 = Cellule2 Then
Cellule1.Offset(0, 8) = Cellule2.Offset(0, 2)
Cellule2.Offset(0, 4).FormulaR1C1 = "x"
Exit For
End If
Next Cellule2
Next Cellule1
Application.ScreenUpdating = True
End Sub


Sur mon petit ordi le temps de traitement est nettement meilleur maintenant ;o))

A adapter pour ta ComPO1.


--
Cordialement,

Rai
Remplacer point par la ponctuation appropriée pour répondre...

Avatar
ced
Ouha, j'suis sur le Q
Donc si je comprends bien, tu traites les trois feuille en même temps
(j'avais déjà fait l'essai mais ça prenait un temps fou), ensuite pour les
instructions appellée j'suis perdu mais c'est pas grave, demain j'essaie en
adaptant et je chronomètre, idem pour l'autre proposition consistant à
délimiter la zone, saufque je ne souhaite pas prendre de risue sur le nombre
de lignes, cependant je peux activer la feuille en même temps que la
cellule.
Merci pour votre aide, je vous informerai des résultats.
A++


"AV" a écrit dans le message de news:
unP92$
Pour aller nettement plus vite, ça pourrait avoir cette allure là (à
adapter)

Sub zzzz()
plg_F1 = "Feuil1!" & Sheets("Feuil1").Range("H1",
Sheets("Feuil1").[H65536].End(3)).Address
plg_F2 = "Feuil2!" & Sheets("Feuil2").Range("D1",
Sheets("Feuil2").[D65536].End(3)).Address
plg_F3 = "Feuil3!" & Sheets("Feuil3").Range("C1",
Sheets("Feuil3").[C65536].End(3)).Address

For Each c In Range(plg_F1)
If Not Application.Range(plg_F2).Find(c.Value, LookAt:=xlWhole) _
Is Nothing Then ' ...traitement pour valeur trouvée en Feuil1 et
Feuil2
Next
If Not Application.Range(plg_F3).Find(c.Value, LookAt:=xlWhole) _
Is Nothing Then ' ...traitement pour valeur trouvée en Feuil1 et
Feuil3
Next
End Sub

AV




Avatar
Jean-Claude
Salut
sans sortir de la boucle for sur 1000,12000 et 300 la macro fait dans les 5
sec. P4 à 2.5
Il faut vérifier éventuellement que les colonnes ne sont pas vides.

Sub ComPO1()

Dim tabTmp1 As Variant
Dim tabTmp2 As Variant
Dim tabTmp3 As Variant

Dim i As Integer
Dim j As Integer

Dim LgnFin1 As Integer
Dim LgnFin2 As Integer
Dim LgnFin3 As Integer
Dim Col1 As Integer
Dim Col2 As Integer
Dim Col3 As Integer

t = Time
LgnFin1 = Sheets("Feuil1").Range("H:H").Find("*", , xlFormulas, ,
xlByRows, xlPrevious).Row
LgnFin2 = Sheets("Feuil2").Range("D:D").Find("*", , xlFormulas, ,
xlByRows, xlPrevious).Row
LgnFin3 = Sheets("Feuil3").Range("C:AC").Find("*", , xlFormulas, ,
xlByRows, xlPrevious).Row
Col1 = Sheets("Feuil1").Range("H:H").Column
Col2 = Sheets("Feuil2").Range("D:D").Column
Col3 = Sheets("Feuil3").Range("C:C").Column

tabTmp1 = Sheets("Feuil1").Range("H1:H" & LgnFin1).Value
tabTmp2 = Sheets("Feuil2").Range("D1:D" & LgnFin2).Value
tabTmp3 = Sheets("Feuil3").Range("C1:C" & LgnFin3).Value

For i = LBound(tabTmp1) To UBound(tabTmp1)
For j = LBound(tabTmp2) To UBound(tabTmp2)
If tabTmp1(i, 1) = tabTmp2(j, 1) Then
Sheets("Feuil1").Cells(i, Col1 + 7) = Sheets("Feuil2").Cells(j,
Col2 - 1)
End If
Next j
For j = LBound(tabTmp3) To UBound(tabTmp3)
If tabTmp1(i, 1) = tabTmp2(j, 1) Then
Sheets("Feuil1").Cells(i, Col1 + 7) = Sheets("Feuil2").Cells(j,
Col3 - 1)
End If
Next j
Next i
t = Format(Time - t, "Long Time")
MsgBox t

Application.ScreenUpdating = True
End Sub

A+
Jc