Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Procédure très longue

Procédure très longue

6 réponses
Avatar
Sunburn
Bonjour,
j'ai une procédure qui met plus de 10 seconde à s'executer, je ne crois pas
que cela soit logique. Peut-on reduire la durée du traitement ?
merci.
YANN
---
Sub Import10()
'supprimer les anciennes lignes
Application.ScreenUpdating = False
Sheets("10").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Delete
Next
'ajoute les lignes
Sheets("10").Select
Range("DETAIL10").Select
For Each C In Worksheets("Bal2").Range("A2:A1000")
n1 = Mid(C, 1, 1)
n2 = Mid(C, 1, 4)
n4 = Mid(C, 1, 4)
n5 = Mid(C, 1, 4)
n10 = Mid(C, 1, 4)
n11 = Mid(C, 1, 4)
n12 = Mid(C, 1, 4)
n13 = Mid(C, 1, 3)
n14 = Mid(C, 1, 4)
If n1 = 1 Or n2 = 6611 Or n4 = 6874 Or n5 = 6875 _
Or n10 = 7865 Or n11 = 7874 Or n12 = 7875 Or n13 = 777 Or n14 = 7872 _
Then
Selection.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(0, 0).Select
Range(C, C.Offset(0, 255).End(xlToLeft)).Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next
End Sub
-----
Signaler un problème avec ce contenu

6 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
FFO
Salut à toi
Si dans ta colonne A il n'ya pas de cellule vide à maintenir
Remplaces :

Application.ScreenUpdating = False
Sheets("10").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Delete
Next

par :

Application.ScreenUpdating = False
Sheets("10").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Clear
Next
Range("A1", "A" & Range("A65535").End(xlUp).Offset(1,
0).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Je pense que celà devrait aller mieux
Dis moi !!!!
Avatar
Sunburn
Re,

en fait, il y a des cellules vide à maintenir en cellule A.

YANN
Avatar
FFO
Rebonjour à toi

As tu une colonne obligatoirement non vide ???

Auquel cas
Adaptes ces lignes en fonction de cette colonne :

Range("A1", "A" & Range("A65535").End(xlUp).Offset(1,
0).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Remplace ici la lettre A par celle de cette colonne

Le code que je t'ai fourni adapté ainsi devrait convenir

Donnes moi des nouvelles !!!!
Avatar
FFO
Rebonjours à toi

On peux aussi pour les cellules vides en colonne A mettre un espace dans ces
cellules afin que leur ligne ne soit pas supprimée
Celà donne ce code :

Application.ScreenUpdating = False
Sheets("10").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) = "" Then
Cells(I, 1) = " "
End If
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Clear
Next
Range("A1", "A" & Range("A65535").End(xlUp).Offset(1,
0).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Peut être ta solution

Dis moi !!!!
Avatar
Michel Angelosanto
Peut être un problème de calcul, faire un essai en calcul manuel.

Ou alors, les variables de boucles ne sont pas définies en integer

A+
"Sunburn" a écrit dans le message de
news:
Bonjour,
j'ai une procédure qui met plus de 10 seconde à s'executer, je ne crois
pas
que cela soit logique. Peut-on reduire la durée du traitement ?
merci.
YANN
---
Sub Import10()
'supprimer les anciennes lignes
Application.ScreenUpdating = False
Sheets("10").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Delete
Next
'ajoute les lignes
Sheets("10").Select
Range("DETAIL10").Select
For Each C In Worksheets("Bal2").Range("A2:A1000")
n1 = Mid(C, 1, 1)
n2 = Mid(C, 1, 4)
n4 = Mid(C, 1, 4)
n5 = Mid(C, 1, 4)
n10 = Mid(C, 1, 4)
n11 = Mid(C, 1, 4)
n12 = Mid(C, 1, 4)
n13 = Mid(C, 1, 3)
n14 = Mid(C, 1, 4)
If n1 = 1 Or n2 = 6611 Or n4 = 6874 Or n5 = 6875 _
Or n10 = 7865 Or n11 = 7874 Or n12 = 7875 Or n13 = 777 Or n14 = 7872 _
Then
Selection.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(0, 0).Select
Range(C, C.Offset(0, 255).End(xlToLeft)).Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next
End Sub
-----



--
Michel Angelosanto, Bordeaux
http://angelosa.free.fr/
Avatar
Sunburn
re,
tu entend quoi par "les variables de boucles ne sont pas définies en
integer" ??
Merci
YANN