Sub ClearContentsSpecialClaudy()
Set MaPlage = Range("A1:F60")
With MaPlage
For Each c In MaPlage
If c.Value <> "OUT" Then c.Value = ""
Next c
End With
End Sub
Sub ClearContentsSpecialClaudy(Plage, Chaine)
Set MaPlage = Range(Plage)
With MaPlage
For Each c In MaPlage
If c.Value <> Chaine Then c.Value = ""
Next c
End With
End Sub
Sub EssaiPourTest()
ClearContentsSpecialClaudy "A1:F60", "OUT"
End Sub
Sub ClearContentsSpecialClaudy(Plage, Chaine)
Application.ScreenUpdating = False
Set MaPlage = Range(Plage)
With MaPlage
For Each c In MaPlage
If c.Value <> Chaine Then c.Value = ""
Next c
End With
Application.ScreenUpdating = True
End Sub
Sub EssaiPourTest()
ClearContentsSpecialClaudy "A1:F60", "OUT"
End Sub
Re bonjour et merciSur mon PC je passe de 0.531s à 0.109s avec la dernière version.
Avez vous beaucoup de calculs dans votre fichier ?
Si oui, rajouter au début : Application.Calculation=xlManual
et à la fin : Application.Calculation=xlautomatic.
( çapasse le mode de recalcul en manuel )
Sub ClearContentsSpecialClaudy(Plage, Chaine)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set MaPlage = Range(Plage)
With MaPlage
For Each c In MaPlage
If c.Value <> Chaine Then c.Value = ""
Next c
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub EssaiPourTest()
t0 = Timer
ClearContentsSpecialClaudy "A1:F60", "OUT"
MsgBox Timer - t0
End Sub
Sub Effacer()
t0 = Timer
Range("A1:F60").Replace What:="OUT", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
MsgBox Timer - t0
End Sub
Heu...Bonsoir le fil, Claudy, sylvanu
Une autre façon (pour le cas ou la cellule contient strictement OUT)
VB:Sub Effacer() t0 = Timer Range("A1:F60").Replace What:="OUT", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows MsgBox Timer - t0 End Sub
Sub Effacer()
Dim TabR As Range
Dim cell As Range
Set TabR = Range("A1:F60")
t0 = Timer
For Each cell In TabR
If cell.Value <> "OUT" Then
cell.Value = ""
End If
Next cell
MsgBox Timer - t0
End Sub
Sub Effacer()
Dim TabR() As Variant
TabR = Range("A1:F60")
t0 = Timer
For i = LBound(TabR, 1) To UBound(TabR, 1)
For j = LBound(TabR, 2) To UBound(TabR, 2)
If TabR(i, j) <> "OUT" Then
TabR(i, j) = ""
End If
Next j
Next i
Range("A1").Resize(UBound(TabR, 1), UBound(TabR, 2)) = TabR
MsgBox Timer - t0
End Sub