Microsoft 365 optimisation d'un programme en utilisant la fonction Array

Thomas_1

XLDnaute Nouveau
Bonjours à toutes et tous.

J'ai créé un programme qui me permet d'effacer les lignes que je n'utilise pas. Après avoir réussi à créer ce programme je me suis aperçu qu'il mettait plusieurs heures à s'exécuter (le fichier fait 110 000 lignes) 😓. Suite à quelques recherches j'ai trouvé plusieurs astuces pour optimiser celui-ci dont l'utilisation de la fonction Array mais je n'arrive pas à l'adapter à mon code. Est ce que quelqu'un pourrait m'aider s'il vous plaît ?

Le code complet est :
Sub delete()

Dim line As Long
Dim x As Long
Dim difference As Long
Dim datarange As Variant

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

'Read all datas in the table
line = Range("A" & Rows.Count).End(xlUp).Row
datarange = ActiveSheet.Range("A2:A" & line).Value

'Delete rows that I won't use in the table
For x = 2 To line
If Cells(x + 1, 1) - Cells(x, 1) < 694 Then
datarange.Rows(x + 1).Delete
Else
x = x + 1
End If
x = x - 1
Next x

'Transcribe all datas in the Excel sheet
Range("A2:A" & line).Value = datarange

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.AskToUpdateLinks = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

End Sub
 
Solution
Bonjour Thomas
voici le code avec 2 macros :
la 1ère pour initialiser une feuilles avec 100 000 lignes pour le test
la 2ème correspond à votre "Delete", ici je test pour une différence entre la ligne et la ligne suivante = 1000
A Noter que la boucle commence par la dernière ligne en remontant !
Le Delete dure 2 minutes 30 sur mon PC peu performant (voir MsgBox)
VB:
Sub InitLignes()
Dim i As Long
    For i = 1 To 100000
        If i Mod 2 = 0 Then
            Cells(i, 1) = i + 1001
        Else
            Cells(i, 1) = i
        End If
    Next i
End Sub
Sub DeleteLignes()
Dim l As Long
Dim Nlig As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    t1 = Timer
    Nlig = Range("A" &...

crocrocro

XLDnaute Occasionnel
Bonjour Thomas
voici le code avec 2 macros :
la 1ère pour initialiser une feuilles avec 100 000 lignes pour le test
la 2ème correspond à votre "Delete", ici je test pour une différence entre la ligne et la ligne suivante = 1000
A Noter que la boucle commence par la dernière ligne en remontant !
Le Delete dure 2 minutes 30 sur mon PC peu performant (voir MsgBox)
VB:
Sub InitLignes()
Dim i As Long
    For i = 1 To 100000
        If i Mod 2 = 0 Then
            Cells(i, 1) = i + 1001
        Else
            Cells(i, 1) = i
        End If
    Next i
End Sub
Sub DeleteLignes()
Dim l As Long
Dim Nlig As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    t1 = Timer
    Nlig = Range("A" & Rows.Count).End(xlUp).Row
   For l = Nlig - 1 To 1 Step -1
      If Cells(l + 1, 1) - Cells(l, 1) < 1000 Then
          Rows(l + 1).Delete
      End If
   Next
   t2 = Timer
   Application.ScreenUpdating = True
    Application.EnableEvents = True
   MsgBox " durée : " & t2 - t1
 
End Sub
 

Dranreb

XLDnaute Barbatruc
Bonsoir.
Un tableau n'étant pas un objet, il ne possède ni propriété ni méthode, en particulier pas de méthode Delete. Tout ce qu'on peut faire c'est y déplacer les valeurs à garder.
VB:
Sub Delete()
   Dim Rng As Range, T(), LE As Long, LS As Long
   Set Rng = ActiveSheet.[A2].Resize(ActiveSheet.[A1000000].End(xlUp).Row - 1)
   T = Rng.Value
   LS = 1
   For LE = 2 To UBound(T, 1)
      If T(LE, 1) - T(LE - 1, 1) >= 694 Then
         LS = LS + 1
         T(LS, 1) = T(LE, 1)
         End If
      Next LE
   While LS < UBound(T, 1): LS = LS + 1: T(LS, 1) = Empty: Wend
   Rng.Value = T
   End Sub
 

patricktoulon

XLDnaute Barbatruc
bonsoir
en voila une drôle de question
j'ai testé diverses méthode
et j'en arrive a une conclusion tu nous a pas tout dit
notamment que quand une/des valeurs ne saute(nt) pas on se retrouve à la fin avec des cellules qui se suivent et dont le resultat de la soustraction passe en dessous le 694

d'autant plus que dès que l'on va tomber sur un nombre < 694 en cellule (x,1)
c'est fini pour le reste
puisque le resultat de la soustraction de la cellule (x+1,1)-cellule(x,1)sera toujours en dessous 694
Alors que fait on?
a mon avis tu va te rendre compte que ce n'est tout a fait ce que tu veux
 

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Je me demande si tu n'as pas oublié d'actualiser la valeur de fin de ta boucle FOR après la suppression d'une ligne, ce qui diminuerait peut-être la durée de traitement de ta macro ?
VB:
Sub Supprimer()
'
Dim ligne As Long
Dim x As Long
Dim difference As Long
'Dim datarange As Variant

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.AskToUpdateLinks = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

    ' Read all datas in the table
    ligne = Range("A" & Rows.Count).End(xlUp).Row
'    datarange = ActiveSheet.Range("A2:A" & line).Value

    ' Delete rows that I won't use in the table
    x = 2
    While x < ligne
        If Cells(x + 1, 1) - Cells(x, 1) < 694 Then
            Cells.Rows(x + 1).delete
            ligne = ligne - 1
        Else
            x = x + 1
        End If
    Wend

    ' Transcribe all datas in the Excel sheet
'    Range("A2:A" & line).Value = datarange

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.AskToUpdateLinks = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic

End Sub





j'en arrive a une conclusion tu nous a pas tout dit
notamment que quand une/des valeurs ne saute(nt) pas on se retrouve à la fin avec des cellules qui se suivent et dont le resultat de la soustraction passe en dessous le 694
Normalement non, puisque si le résultat de la soustraction est inférieur à 694, on supprime la ligne x+1.


d'autant plus que dès que l'on va tomber sur un nombre < 694 en cellule (x,1)
c'est fini pour le reste
puisque le resultat de la soustraction de la cellule (x+1,1)-cellule(x,1)sera toujours en dessous 694
T'es sûr de ça ?

Si en cellule (x,1) on 4 (qui est un nombre < 694) et qu'en cellule (x+1,1) on a 1000, le résultat de la soustraction de la cellule (x+1,1)-cellule(x,1) donne 996, qui n'est pas en-dessous de 694.
 
Dernière édition:

Discussions similaires

Réponses
28
Affichages
1 K

Statistiques des forums

Discussions
313 283
Messages
2 096 811
Membres
106 751
dernier inscrit
Souleymani