Discussion :

[Maxou 10]

Bonjour à tous,

J'ai fais une macros pour effacer des cellules quand une case est vide dans ma plage F4:F27.
J'aurais voulu savoir s'il était possible de simplifier ?
De plus, est il possible de le rendre plus rapide dans son exécution ?

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Effacer()
    Dim i As Integer
 
    For i = 4 To 27
        If Cells(i, 6).Value = "" Then
            Cells(i, 6).Offset(0, 4).ClearContents
            Cells(i, 6).Offset(0, 5).ClearContents
            Cells(i, 6).Offset(0, 6).ClearContents
            Cells(i, 6).Offset(0, 7).ClearContents
        End If
    Next i
 
End Sub

Merci pour votre aide et bonne soirée

[Invité]

Essaie ce code:

Code :

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

1
2
3
4
5
  Dim cl
  On Error Resume Next 
  For Each cl In Range("F4:F27").SpecialCells(xlCellTypeBlanks)
     cl.Offset(0, 4).Resize(1, 4).ClearContents
  Next

[BENNASR]

Bonjour

De plus, est il possible de le rendre plus rapide dans son exécution ?

Il est recommandé d'arrêter l'affichage écran au début de l'exécution et réactiver à la fin avec :

Code :

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

1
2
3
4
5
6
7
8
Application.ScreenUpdating = False
 
'ton code
 
.
.
Application.ScreenUpdating = true
end sub

[deedolith]

Bonjour

Il est recommandé d'arrêter l'affichage écran au début de l'exécution et réactiver à la fin avec :

Code :

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

1
2
3
4
5
6
7
8
Application.ScreenUpdating = False
 
'ton code
 
.
.
Application.ScreenUpdating = true
end sub

Heu ...
Ca, c'est sous conditions:

1. Si le besoin de performances se fait sentir (bien souvent: inutile).
2. En fin de développement, une fois que le comportement désiré a été obtenu / testé.

Premature optimisation is the root of all evils in software development (or at least, most of it).
D.Knuth

[Maxou 10]

Voici le code que j'ai fait.

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
Sub BoutonEffacer()
    Dim i As Integer
 
    Application.ScreenUpdating = False
 
    For i = 4 To 27
        If Cells(i, 6).Value = "" Then
            Cells(i, 6).Offset(0, 3).Resize(1, 2).ClearContents
            Cells(i, 6).Offset(0, 6).Resize(1, 4).ClearContents
        End If
    Next i
 
    Application.ScreenUpdating = True
 
End Sub

Merci a tous pour votre aide.

[Franc]

Ou si tu veux appliquer ClearContents d'un seul coup

Code :

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

1
2
3
4
5
6
7
8
9
10
  Dim cl, Rg As Range
  On Error Resume Next
  For Each cl In Range("F4:F27").SpecialCells(xlCellTypeBlanks)
     If Rg Is Nothing Then
        Set Rg = cl.Offset(0, 4).Resize(1, 4)
     Else
        Set Rg = Union(Rg, cl.Offset(0, 4).Resize(1, 4))
     End If
  Next
  Rg = ClearContents

[/QUOTE]

Attention, ce n'est pas Rg = ClearContents mais Rg.ClearContents

[Invité]

Merci pour la correction, c'était une erreur de ma part