Microsoft 365 Effacer sous condition

[Claudy]

Bonjour à tous,
Comment faire un Range("A1:F60").ClearContents, mais ne pas effacer si une cellule contient le mot "OUT" ?

Merci d'avance,
Claudy

 

[sylvanu]

Bonjour Claudy,
Testez ça pour voir :

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

 

[Claudy]

Heu merci,
mais ça me semble assez long comme timming...
A+
Claudy

 

[sylvanu]

ou mieux :

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

De cette façon la macro est universelle, et vous pourrez la réutiliser sans modification.
Pour l'executer il faut lancer EssaiPourTest avec deux paramètres : la plage et la chaine à exclure.

 

[sylvanu]

Le temps n'était pas dans les specs de départ 🙂
Il faut figer l'écran pendant l'effacement. ca accélère beaucoup l'éxécution.

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

 

[sylvanu]

Sur 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 )

 

[Claudy]

Sur 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 )

Re bonjour et merci
Dans ce classeur test je n'ai rien comme calculs.
Mais ouvert un autre classeur avec des centaines de formules (normales ou matricielles)
Et aucun lien avec fichier test.
Est ce que ça peut influencer?
A+
Claudy

 

[sylvanu]

Surement s'ils sont dans la même session.
Dans ce cas ajouter les deux lignes Application.Calculation=xlManual , ça devrait résoudre le problème.
Voici la dernière version, j'ai intégré :

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

Dans le test j'ai introduit la mesure du temps d'éxecution.

 

[Staple1600]

Bonsoir le fil, Claudy, sylvanu

Une autre façon (pour le cas ou la cellule contient strictement OUT)

Sub Effacer()
t0 = Timer
Range("A1:F60").Replace What:="OUT", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
MsgBox Timer - t0
End Sub

 

[Claudy]

Bonsoir le fil, Claudy, sylvanu

Une autre façon (pour le cas ou la cellule contient strictement OUT)

Sub Effacer()
t0 = Timer
Range("A1:F60").Replace What:="OUT", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
MsgBox Timer - t0
End Sub

Heu...
il m'éfface les OUT!
A+
Claudy

 

[Staple1600]

Re

Oui, avec le froid, cela arrive. 😉
Mon neurone se fige brutalement et je comprends la question à l'envers 😉
En bref, je suis OUT quoi 😉

 

[laurent950]

Bonsoir Staple1600, Claudy, Sylvanus, le Forum

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

 

[sylvanu]

Bonsoir Staple1600, Claudy, Laurent, le Forum
C'est exactement ma proposition, auquel il faut rajouter les Events OFF car Claudy trouve que ça ramait un peu trop.

 

[laurent950]

Bonsoir sylvanus,

Toutes les cellules de la plages sont à effacer sauf pour celle qui contiennent "OUT"
En passant par une variable tableau le résultat est instantané.
l'objet range est bien plus lourd est donc moins rapide.

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