Accéléré l’exécution d'une Macro-Fonctionnement simple

H

Haytoch

XLDnaute Junior
Bonjour,

J'ai une petite macro avec fonctionnement très simple mais , elle prend plus du temps lors de l'exécution (2 a 3 min) sur 59570 lignes . est ce que c'est normale ? merci de m'aide si ce n'est pas vraiment logique !! au moins ce que je pense :p .

Merci d'avance.

voici mon code :
Code: 
Sub Check_Lengths()
Dim Bws As Worksheet, I As Long, ChVa As Variant
 
Set Bws = Worksheets("AA")
    Application.ScreenUpdating = False
        For I = 3 To Bws.Range("A" & Rows.Count).End(xlUp).Row
            Cells(I, 11) = 0
            Cells(I, 12) = 0
            Cells(I, 13) = 0
            Cells(I, 14) = 0
            Cells(I, 15) = 0
            ChVa = Cells(I, 9)
                If ChVa > 0 And ChVa <= 1 Then
                    Cells(I, 11) = 1
                ElseIf ChVa > 1 And ChVa <= 3 Then
                    Cells(I, 12) = 1
                ElseIf ChVa > 3 And ChVa <= 5 Then
                    Cells(I, 13) = 1
                ElseIf ChVa > 5 And ChVa <= 10 Then
                    Cells(I, 14) = 1
                ElseIf ChVa > 10 Then
                    Cells(I, 15) = 1
                End If
        Next I
    Application.ScreenUpdating = True
End Sub

Salut
haytoch
 
Trier par date Trier par votes
M

mécano41

XLDnaute Accro
Re : Accéléré l’exécution d'une Macro-Fonctionnement simple

Bonjour,

Vérifie si le résultat est celui attendu mais, en utilisant un tableau, 2 secondes pour 50000 lignes.


Code: 
Option Explicit
Option Base 1

Sub Check_Lengths()
Dim Bws As Worksheet, I As Long, ChVa As Variant
Dim NbLignes As Long
Dim T() As Single
Set Bws = Worksheets("AA")
NbLignes = Bws.Range("A" & Rows.Count).End(xlUp).Row - 2
ReDim T(NbLignes, 5)
    Application.ScreenUpdating = False
        For I = 1 To NbLignes - 2
            ChVa = Cells(I + 2, 9)
                If ChVa > 0 And ChVa <= 1 Then
                    T(I, 1) = 1
                ElseIf ChVa > 1 And ChVa <= 3 Then
                    T(I, 2) = 1
                ElseIf ChVa > 3 And ChVa <= 5 Then
                    T(I, 3) = 1
                ElseIf ChVa > 5 And ChVa <= 10 Then
                    T(I, 4) = 1
                ElseIf ChVa > 10 Then
                    T(I, 5) = 1
                End If
        Next I
    Range("K3").Resize(NbLignes, 5).Value = T
    Application.ScreenUpdating = True
End Sub

EDIT : j'ai essayé avec un Variant T au lieu d'un tableau T() mais pas de différence visible...

Cordialement
 
Dernière édition:
Vote positif 0 Vote négatif
L

laetitia90

XLDnaute Barbatruc
Re : Accéléré l’exécution d'une Macro-Fonctionnement simple

bonjour Haytoch,mécano:)
peut être plus simple de l'ecrire comme cela... pas forcement plus rapide..... adapter nom feuille ...code_name feuil



Code: 
Sub es()
 Dim t(), i As Long
 Application.ScreenUpdating = 0
 t = Feuil1.Range("i3:o" & Feuil1.Cells(Rows.Count, 1).End(xlUp).Row)
 For i = 1 To UBound(t)
 t(i, 3) = 0: t(i, 4) = 0: t(i, 5) = 0: t(i, 6) = 0: t(i, 7) = 0
 If t(i, 1) > 0 And t(i, 1) <= 1 Then t(i, 3) = 1
 If t(i, 1) > 1 And t(i, 1) <= 3 Then t(i, 4) = 1
 If t(i, 1) > 3 And t(i, 1) <= 5 Then t(i, 5) = 1
 If t(i, 1) > 5 And t(i, 1) <= 10 Then t(i, 6) = 1
 If t(i, 1) > 10 Then t(i, 7) = 1
 Next i
 Feuil1.Range("i3").Resize(UBound(t, 1), UBound(t, 2)) = t
End Sub
 
Vote positif 0 Vote négatif
H

Haytoch

XLDnaute Junior
Re : Accéléré l’exécution d'une Macro-Fonctionnement simple

Bonjour,

Merci a vous deux :) les code marche bien.

@mécano:
Remarque ton code s'exécute rapidement , mais ne donne pas les bonnes résultats !! aussi une remarque que il ajoute des '0' sur les deux dernière lignes de la feuille même si il contiens pas des infos dans cellules de ces deux lignes.

@laetitia90 :

ton code s'exécute aussi rapidement ==> 7s pour tous les lignes

Merci une autre fois pour votre aide :)
 
Vote positif 0 Vote négatif
L

laetitia90

XLDnaute Barbatruc
Re : Accéléré l’exécution d'une Macro-Fonctionnement simple

re,

Code: 
Sub es()
 Dim t(), i As Long
 Application.ScreenUpdating = 0
 t = Feuil1.Range("i3:o" & Feuil1.Cells(Rows.Count, 1).End(xlUp).Row)
 Feuil1.Range("k3:o" & Feuil1.Cells(Rows.Count, 1).End(xlUp).Row) = 0
 For i = 1 To UBound(t)
 If t(i, 1) > 0 And t(i, 1) <= 1 Then t(i, 3) = 1
 If t(i, 1) > 1 And t(i, 1) <= 3 Then t(i, 4) = 1
 If t(i, 1) > 3 And t(i, 1) <= 5 Then t(i, 5) = 1
 If t(i, 1) > 5 And t(i, 1) <= 10 Then t(i, 6) = 1
 If t(i, 1) > 10 Then t(i, 7) = 1
 Next i
 Feuil1.Range("i3").Resize(UBound(t, 1), UBound(t, 2)) = t
End Sub

quoi que c'est pas bon dans ce cas la le resize du tablo ecrase les 0 j'aurais du teste avant:(

il faut inverser ces 2 lignes

t = Feuil1.Range("i3:eek:" & Feuil1.Cells(Rows.Count, 1).End(xlUp).Row)
Feuil1.Range("k3:eek:" & Feuil1.Cells(Rows.Count, 1).End(xlUp).Row) = 0

par

Feuil1.Range("k3:eek:" & Feuil1.Cells(Rows.Count, 1).End(xlUp).Row) = 0
t = Feuil1.Range("i3:eek:" & Feuil1.Cells(Rows.Count, 1).End(xlUp).Row)


Code: 
Sub es()
 Dim t(), i As Long
 Application.ScreenUpdating = 0
  Feuil1.Range("k3:o" & Feuil1.Cells(Rows.Count, 1).End(xlUp).Row) = 0
  t = Feuil1.Range("i3:o" & Feuil1.Cells(Rows.Count, 1).End(xlUp).Row)
 For i = 1 To UBound(t)
 If t(i, 1) > 0 And t(i, 1) <= 1 Then t(i, 3) = 1
 If t(i, 1) > 1 And t(i, 1) <= 3 Then t(i, 4) = 1
 If t(i, 1) > 3 And t(i, 1) <= 5 Then t(i, 5) = 1
 If t(i, 1) > 5 And t(i, 1) <= 10 Then t(i, 6) = 1
 If t(i, 1) > 10 Then t(i, 7) = 1
 Next i
 Feuil1.Range("i3").Resize(UBound(t, 1), UBound(t, 2)) = t
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
M

mécano41

XLDnaute Accro
Re : Accéléré l’exécution d'une Macro-Fonctionnement simple

Haytoch à dit:
...
@mécano:
Remarque ton code s'exécute rapidement , mais ne donne pas les bonnes résultats !!
Cliquez pour agrandir...

Je viens de lancer ton code et le mien sur deux zones de colonnes différentes et j'ai fait la comparaison dans une troisième zone : je ne trouve aucun écart...

EDIT ; je viens de voir que dans le premier code sur le forum, il n'y avait pas la ligne Option base 1 alors qu'elle est chez moi...Ceci explique probablement cela...

... aussi une remarque que il ajoute des '0' sur les deux dernière lignes de la feuille même si il contiens pas des infos dans cellules de ces deux lignes.
Cliquez pour agrandir...

Oui, j'ai oublié qu'il y avait des lignes vides en haut.(je remplace le code dans mon premier message

Cordialement
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

L
  • Résolu(e)
Microsoft 365 Suppression de cellules vide
Réponses
3
Affichages
188
Le Rouky
L
D
  • Question
XL 2010 Valoriser cellule par clic
Réponses
4
Affichages
233
fanch55
fanch55
M
  • Question
XL 2013 Bouton commande ne fonctionne pas
Réponses
7
Affichages
222
midovic
M
S
  • Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
156
souhaib ad
S
R
  • Question
XL 2016 excel 2016 VBA
Réponses
2
Affichages
162
rebatte
R
F
  • Question
XL 2019 l'indice n'appartient pas à la sélection
Réponses
9
Affichages
554
job75
job75
R
  • Question
Microsoft 365 Couleur de fond de textbox [CLOTURE]
Réponses
2
Affichages
534
romubzh35
R
D
  • Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
350
dadu35
D
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
84
Latias
L
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
947
thivame
T

Membres actuellement en ligne

16 membres et 86 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 322
Messages
2 087 285
Membres
103 507
dernier inscrit
tapis23