Microsoft 365 Comment supprimer le contenu d'un cellule automatiquement

job75 à dit:

Bonsoir Lucho63,

Plusieurs questions :

- supprimer ou effacer ?

- si supprimer, décaler vers la gauche ou vers le haut ?

- si effacer, faut-il effacer aussi la couleur orange ou la remplacer par du jaune ?

- quel critère avez-vous utilisé pour colorer en orange ? Valeur Inférieure à 1 ?

A+

Cliquez pour agrandir...

sylvanu à dit:

Bonjour Lucho,
Un essai en PJ avec :

VB:

Sub Efface()
For Each cell In Range("A1").CurrentRegion
    If cell.Interior.Color = RGB(255, 192, 0) Then
        cell.Value = ""
        cell.Interior.Color = xlColorIndexNone
    End If
Next
End Sub

Cliquez pour agrandir...

Lucho63 à dit:

Je souhaite supprimer les cellules oranges ci-dessous

Cliquez pour agrandir...

sylvanu à dit:

Désolé de n'avoir pas compris. 🙄

Cliquez pour agrandir...

Lucho63 à dit:

Au mieux, supprimer et décaler vers la gauche, mais supprimer me suffira.

Cliquez pour agrandir...

job75 à dit:

Quand on supprime une cellule :

- soit les cellules à droite se décalent vers la gauche

- soit les cellules en dessous se décalent vers le haut.

Cliquez pour agrandir...

Lucho63 à dit:

J'ai besoin que les cellules se décalent vers la gauche

Cliquez pour agrandir...

Sub Supprimer()
Dim ncol%, i&, j%, x
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
    ncol = .Columns.Count
    For i = 1 To .Rows.Count
        For j = ncol To 1 Step -1
            x = .Cells(i, j)
            If IsNumeric(CStr(x)) Then If x < 1 Then .Cells(i, j).Delete xlToLeft
    Next j, i
End With
End Sub

job75 à dit:

Alors utilisez cette macro :

VB:

Sub Supprimer()
Dim ncol%, i&, j%, x
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
    ncol = .Columns.Count
    For i = 1 To .Rows.Count
        For j = ncol To 1 Step -1
            x = .Cells(i, j)
            If IsNumeric(CStr(x)) Then If x < 1 Then .Cells(i, j).Delete xlToLeft
    Next j, i
End With
End Sub

Cliquez pour agrandir...

sylvanu à dit:

Il faut toujours persévérer. 😅

Cliquez pour agrandir...