Macro trop longue, simplification

**laduche31** · 12/12/2011, 11h56

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 12/12/2011, 12h23

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 12/12/2011, 12h29

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating = False

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

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

**laduche31** · 12/12/2011, 13h38

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 12/12/2011, 13h44

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** · 12/12/2011, 13h46

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** · 12/12/2011, 14h00

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 12/12/2011, 14h05

Merci!

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Adrien

**mercatog** · 12/12/2011, 14h12

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 12/12/2011, 14h17

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** · 12/12/2011, 14h24

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**redstoff** · 12/12/2011, 14h26

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Calculation = xlManual

et en derniere ligne d ela macro tu mets

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Calculation = xlAutomatic

test et dis moi quoi

perso pour moi ca a deja acceleré mes macros

**laduche31** · 12/12/2011, 14h33

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** · 12/12/2011, 14h40

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.

Macro trop longue, simplification [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager