[XL-2007] Macro trop longue, simplification [Résolu]

[laduche31]

Bonjour à tous!

J'ai une macro qui fonctionne bien mais est beaucoup trop longue.. (environ 12 secondes)

Ce que je cherche à faire:
1 - Enlever les filtres actifs (sans les supprimer)
2 - Insérer une ligne à la fin du tableau qui recopie les formules de la ligne du dessus
3 - Insérer la valeur "31.12.2020" en colonne 296,
4 - Se positionner sur la colonne 2

Voici mon code :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Bouton9_Clic()
 
On Error Resume Next
Sheets("Feuil1").ShowAllData
On Error GoTo 0
 
 
  Range("A2").Select 'la première cellule de la ligne de titre
  Selection.End(xlDown).Select 'la dernière cellule de la colonne A avant la cellule vide
  Selection.EntireRow.Copy
  Selection.Insert shiftXldown
  Selection.Offset(1).Select  'positionnement sur la nouvelle ligne
  For Each c In Intersect(ActiveSheet.UsedRange, Selection.EntireRow)
    If Left(c.Formula, 1) <> "=" Then c.Value = ""
  Next
  Selection = Selection.Offset(-1) + 1  ' incrémentation de la valeur en colonne A
 
Application.CutCopyMode = False
Selection.Offset(0, 296).Select 
Selection.Value = "31.12.2020" 
Selection.Offset(0, -295).Select
 
End Sub

Voilà si vous avez des idées je suis preneur! Merci

Adrien

[mercatog]

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Bouton9_Clic()
Dim LastLig As Long
Dim c As Range
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("Feuil1")
    If .FilterMode Then .ShowAllData
    Set c = .UsedRange.Find("*", , , , xlByColumns, xlPrevious)
    If Not c Is Nothing Then
        LastLig = c.Row
        Set c = Nothing
        .Rows(LastLig).Copy .Range("A" & LastLig + 1)
        .Rows(LastLig + 1).SpecialCells(xlConstants).ClearContents
        .Cells(LastLig + 1, 296) = "31.12.2020"
    End If
End With
Application.Calculation = xlCalculationAutomatic
End Sub

[defluc]

Adresses directement les cellules plutôt qu'utiliser des sélections.
ActiveSheet.Cells(Row, Col)
En première instruction, places

Code :

Application.ScreenUpdating = False

et rétablis cette valeur à True en fin de processus.

L'exécution se fera un un clin d'oeil.

[laduche31]

Bonjour à vous et tout d'abord merci pour votre aide!

Mercatog votre code ne fonctionne pas, je n'ai pas d'erreurs mais rien ne se passe en fait.

defluc j'ai ajouté les instructions

Code :

Application.ScreenUpdating = False

puis true en fin avec succès.

Cependant je n'ai pas réussi à transcrire les Selection par ActiveSheet.Cells(0, 299) = "31.12.2020"
Ca me met une erreur.

Adrien.

[mercatog]

laduche31, mon code fonctionne (à moins si tu ne l'as pas adapté).

Dans ton éditeur vba, fais une exécution pas à pas, à l'aide de F8 et regarde ce qui se passe.

[laduche31]

Ok je regarde à nouveau et je te redis

Merci,

Adrien

EDIT : J'ai compris pourquoi ça ne "marchait pas". En fait plus bas j'ai un deuxième tableau donc la ligne va s'insérer en bas du deuxième tableau.
Je cherche à insérer en fin de 1er tableau, pardon de ne pas avoir précisé.
Serait-il également possible d'incrémenter la valeur en colonne A?
(J'ai des chiffres en colonne A : 127,128,...)

En tout cas niveau rapidité c'est parfait!

Merci!

[mercatog]

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Bouton9_Clic()
Dim LastLig As Long
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("Feuil1")
    If .FilterMode Then .ShowAllData
    LastLig = .Range("A2").CurrentRegion.Rows.Count + 1
    Set c = Nothing
    .Rows(LastLig).Copy
    .Rows(LastLig + 1).Insert
    Application.CutCopyMode = False
    .Rows(LastLig + 1).SpecialCells(xlConstants).ClearContents
    .Cells(LastLig + 1, 296) = "31.12.2020"
    .Cells(LastLig + 1, 1) = Val(.Cells(LastLig, 1)) + 1
End With
Application.Calculation = xlCalculationAutomatic
End Sub

[laduche31]

Merci!

Cependant le débogeur me trouve une erreur là :

Code :

.Rows(LastLig + 1).SpecialCells(xlConstants).ClearContents

Adrien

[mercatog]

Erreur au cas ou tu n'as pas de données en dur sur la ligne.
Comme ceci, ça va aller

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Bouton9_Clic()
Dim LastLig As Long
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("Feuil1")
    If .FilterMode Then .ShowAllData
    LastLig = .Range("A2").CurrentRegion.Rows.Count + 1
    .Rows(LastLig).Copy
    .Rows(LastLig + 1).Insert
    Application.CutCopyMode = False
    On Error Resume Next
    .Rows(LastLig + 1).SpecialCells(xlConstants).ClearContents
    On Error GoTo 0
    .Cells(LastLig + 1, 296) = "31.12.2020"
    .Cells(LastLig + 1, 1) = Val(.Cells(LastLig, 1)) + 1
End With
Application.Calculation = xlCalculationAutomatic
End Sub

[laduche31]

Ca ne m'insère pas de ligne cette fois-ci,
dans la colonne A deux lignes plus loins j'ai la valeur "1" qui s'insère mais rien de +plus.

[defluc]

Cependant je n'ai pas réussi à transcrire les Selection par ActiveSheet.Cells(0, 299) = "31.12.2020"
Ca me met une erreur.

En openOffice, la valeur minimum de Row et de column est 0 mais en Ms-Office, c'est 1.

Essaies donc avec

Code :

ActiveSheet.Cells(1, 299) = "31.12.2020"

[redstoff]

Bonjour,

je ne te garatie pas que ca va marcher mais tu peux toujours tester

tu prends la macro que tu as cré au début

juste en dessous du sub, donc en premiere ligne de ta macro, tu mets

Code :

Application.Calculation = xlManual

et en derniere ligne d ela macro tu mets

Code :

Application.Calculation = xlAutomatic

test et dis moi quoi

perso pour moi ca a deja acceleré mes macros

[laduche31]

Defluc tu as raison c'était ça le problème, ca marche parfaitement maintenant! Merci!

Redstoff j'ai également essayé ta solution et oui ca marche parfaitement! Bon à savoir d'ailleurs! Merci

Mercatog je pense qu'on approchait également du but avec ta solution, merci beaucoup pour ton aide!

A bientôt !

Adrien.

[mercatog]

Donc je suis obligé de décrire mon fichier sur lequel j'ai fais le test.
Feuille Feuil1
en ligne 2, les titres des colonnes.
en ligne 3, j'ai des valeurs et formules et en A3 j'ai 1.

je lance la macro, j'ai en ligne 4, en A4 j'ai 2, les formules se reportent sans les valeurs en dur.