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
-----
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
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 !!!!
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 !!!!
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 !!!!
Sunburn
Re,
en fait, il y a des cellules vide à maintenir en cellule A.
YANN
Re,
en fait, il y a des cellules vide à maintenir en cellule A.
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 !!!!
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 !!!!
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
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 !!!!
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/
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" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news:3D8B7961-2581-4D5B-BB22-BEF16C099B93@microsoft.com...
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/
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/
Sunburn
re, tu entend quoi par "les variables de boucles ne sont pas définies en integer" ?? Merci YANN
re,
tu entend quoi par "les variables de boucles ne sont pas définies en
integer" ??
Merci
YANN