Discussion :

[Identifiant75]

Bonjour,

Je voudrais optimiser le temps d’exécution d'une macro que je viens de réaliser mais qui est relativement lente.
Elle supprime les lignes qui ne contiennent un autre caractère que "0" dans les cellules de la colonne A à la 16e position.
Voici le code:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub DelEditeur()
Dim i As Long
With ThisWorkbook.Sheets("Feuil1")
 
            For i = .Range("A" & .Rows.Count).End(xlUp).Row To 1 Step -1
 
                        If Mid(.Range("A" & i), 16, 1) <> "0" Then
                                   .Rows(i).Delete
                        End If
            Next i
End With
End Sub

Et si le temps d’exécution se voit très réduit, comment l'appliquer a tous les onglets de mon fichier?

Cordialement,

[joe.levrai]

bonjour,

par expression régulière peut être ?

voici un exemple, on cherche si la chaine de caractère d'une cellule possède le chiffre 0 en 16ème position.
Le résultat obtenu est le nombre de cellule de la plage, qui répondent à ce critère

il faut activer la référence Microsoft VBScript Regular Expressions X.X

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
Sub Expregg()
Dim reg As New RegExp
Dim Cell As Range
 
 
reg.Pattern = "(.{15})(0)(.)"
 
For Each Cell In Selection.Cells
If reg.Test(Cell.Value) Then
    cpt = cpt + 1
End If
Next
 
MsgBox cpt
 
End Sub

[Identifiant75]

il faut activer la référence Microsoft VBScript Regular Expressions X.X

Comment procéder ?

[joe.levrai]

Dans ton éditeur de code VBE, tu vas dans le menu "Outils" puis "Références"

t'as une liste de toutes les références, tu cherches celle dont je parle et tu coches la case à côté


regarde si ça accélère le temps de traitement

sinon, on passera par une variable tableau pour boucler, ce qui est beaucoup plus rapide qu'une boucle directement sur ta plage Excel

[Djohn92]

Déjà, tu peux interrompre le recalcul automatique avant la boucle et le réactiver après

désactiver

Code :

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

Application.Calculation = xlCalculationManual

réactiver

Code :

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

Application.Calculation = xlCalculationAutomatic

Ensuite, tu peux désactiver le raffraichissement écran
Avant

Code :

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

application.screenupdating = false

Après

Code :

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

application.screenupdating = true

Les gains seront très visible.


L'autre solution plus bourrin encore consiste à faire une macro qui filtre sur ton critère (inversé)
Supprime les enreigistrements chiants.
Désactive le filtre

[Daniel.C]

Bonjour,

Essaie :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Dim Plage As Range
Set Plage = Range("A1", Cells(Rows.Count, 1).End(xlUp))
Plage.AutoFilter
Plage.AutoFilter 1, "<>???????????????0*"
If Plage.Rows.Count > 1 Then
    Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1, 1)
    Set Plage = Plage.SpecialCells(xlCellTypeVisible)
    If Application.Subtotal(103, Plage) > 0 Then
        Plage.EntireRow.Delete
    End If
End If
Plage.AutoFilter

[joe.levrai]

Super Daniel.C

j'arrivais pas à trouver une méthode simple en passant par les Autofilter, sans avoir à inverser les choix ou effectuer des multi-tris

c'était tellement simple que j'ai fait l'impasse

Bravo

[Identifiant75]

Je vous remercie, je vais essayer ces options!

[Identifiant75]

Cette dernière solution supprime toutes les lignes...

Le format de la cellule filtrée est : AAAA/MM/JJ HH:mm:ss.ffff

Donc je veux supprimer le 16e caractere qui représente les minutes, si celui si est différent de 0...

[Daniel.C]

Effectivement, ça ne fonctionne pas avec des valeurs numériques. Essaie :

Code :

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

1
2
3
4
5
6
7
8
9
10
Dim Tabl As Variant
With ThisWorkbook.Sheets("Feuil2")
    Tabl = Application.Transpose(.Range("A1", .Cells(.Rows.Count, 1).End(xlUp)))
    For i = UBound(Tabl) To 1 Step -1
        Debug.Print Mid(Tabl(i), 16, 1)
        If Mid(Tabl(i), 16, 1) <> "0" Then
            .Rows(i).Delete
        End If
    Next i
End With

[Identifiant75]

Fonctionnelle mais toujours trop lente...

Je commence a croire que la seule alternative est d'avoir un processeur plus puissant ...

(comment l'appliquer à tous les onglets ?)

[Daniel.C]

Si Feuil2 est la feuille active, ajoute avant le code :

Code :

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

1
2
3
4
Dim inCalculationMode As Integer
Application.ScreenUpdating = False
inCalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual

et à la fin, pour remettre les lieux dans l'état où ils étaient auparavant :

Code :

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

1
2
Application.Calculation = inCalculationMode
Application.ScreenUpdating = True

[Daniel.C]

Ou ça, si ça fait une différence :

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
Dim Tabl As Variant, Plage As Range
Dim inCalculationMode As Integer
Application.ScreenUpdating = False
inCalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual
With ThisWorkbook.Sheets("Feuil2")
    Tabl = Application.Transpose(.Range("A1", .Cells(.Rows.Count, 1).End(xlUp)))
    For i = UBound(Tabl) To 1 Step -1
        Debug.Print Mid(Tabl(i), 16, 1)
        If Mid(Tabl(i), 16, 1) <> "0" Then
            If Plage Is Nothing Then
                Set Plage = Rows(i)
            Else
                Set Plage = Union(Rows(i), Plage)
            End If
        End If
    Next i
    Plage.Delete
End With
Application.Calculation = inCalculationMode
Application.ScreenUpdating = True

[Identifiant75]

J'avais déjà ajouté ces modifications... toujours trop lente...

Chaque onglet fais aux alentours des 250 000 lignes

[Identifiant75]

Macro rapide mais apres analyse des résultats, non fonctionnelle

Ci-joint, un fichier exemple

Feuil2.xlsm

[joe.levrai]

Bonjour,

j'ai testé la macro et ça semblait être ok

dans le doute quand même, j'ai retouché un chouilla la macro, et j'ai bien les lignes "dont les minutes ne sont pas égales à 0" qui se suppriment

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
Sub DelEditeur2()
 
Dim Tabl As Variant, Plage As Range
Dim inCalculationMode As Integer
Dim i As Long
Application.ScreenUpdating = False
inCalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual
With ThisWorkbook.Sheets("F2")
    Tabl = Application.Transpose(.Range("A1", .Cells(.Rows.Count, 1).End(xlUp)))
    For i = UBound(Tabl) To 1 Step -1
        If Mid(Tabl(i), 16, 1) <> "0" Then
            .Rows(i).Delete
        End If
    Next i
End With
Application.Calculation = inCalculationMode
Application.ScreenUpdating = True
 
End Sub

[Identifiant75]

Ca me laisse les lignes du genre : 06:48, 08:56, .... alors que j'aimerais (09:00, 09:10, 09:20, 09:30,......)

Possibilité de voir votre fichier ? bizarre que ca marche chez vous et pas chez moi...
Vous utilisez bien XL 2007?

[joe.levrai]

J'ai utilisé la macro de Daniel.C (ainsi que celle que j'ai modifié sensiblement) directement sur ton fichier

testé sur Excel 2010 et 2013 ... je vois pas ce qui bloquerait sur 2007

[Identifiant75]

Je réessaie demain et je vous tiens au courant.
La nuit porte conseille ...

[Identifiant75]

Nickel ca marche, C'était surement la fatigue hier

Derniere choses: Un moyen pour l'appliquer à tous les onglets ?


Oups, non ca ne marche pas pour un grand nombre de ligne, je vous créer un fichier excel test pour vous montrer ...

http://www.cjoint.com/15mi/EEflhNI8ur8.htm