Sélection selon motif de la cellule

[RollyLCXL]

Bonjour,

Dans une feuille avec plusieurs différents motif exemple interior.colorindex … il y a du automatic,, 15, 18, 35. … et avec … énormément de cellules. Donc je cherche à éviter de faire For each cell … etc.

Je cherche à effacer le contenue de toutes les cellules n'ayant pas comme motif 19.

Je connais FindFormat. Mais alors je dois l'utiliser pour tous les autres motifs un motif à la fois pour faire des "clear".

N'y aurait-il pas moyen de plutôt effacer le contenu de toutes les cellules n'ayant pas comme motif 19 mais en une seule opération?

Par exemple avec le FindFormat il semble qu'on ne peut utiliser <> 19 comme motif. Il semble qu'il faut utiliser = 35 et faire Clear, = 15 et faire le Clear etc.

Merci à l'avance.

 

[job75]

Bonjour RollyLCXL,

Je cherche à effacer le contenue de toutes les cellules n'ayant pas comme motif 19.

S'il s'agit juste d'effacer le contenu (pas la couleur) exécutez cette macro :

Sub Effacer()
Dim coul&, tablo, ncol%, i&, j%
coul = 19 'code couleur à adapter
With ActiveSheet.UsedRange
    tablo = .Resize(.Rows.Count + 1).Formula 'matrice, plus rapide, au moins 2 éléments
    ncol = UBound(tablo, 2)
    For i = 1 To UBound(tablo) - 1
        For j = 1 To ncol
            If .Cells(i, j).Interior.ColorIndex <> coul Then tablo(i, j) = ""
    Next j, i
    If .Parent.FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Formula = tablo 'restitution
End With
End Sub

Elle est rapide car elle utilise un tableau VBA restitué en bloc.

A+

 

[job75]

Re,

Si l'on veut aussi effacer les couleurs utiliser :

Sub Effacer2()
Dim coul&, tablo, ncol%, i&, j%
coul = 19 'code couleur à adapter
With ActiveSheet.UsedRange
    tablo = .Resize(.Rows.Count + 1).Formula 'matrice, plus rapide, au moins 2 éléments
    ncol = UBound(tablo, 2)
    For i = 1 To UBound(tablo) - 1
        For j = 1 To ncol
            If .Cells(i, j).Interior.ColorIndex <> coul Then tablo(i, j) = "" Else If tablo(i, j) = "" Then tablo(i, j) = " "
    Next j, i
    If .Parent.FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Formula = tablo 'restitution
    On Error Resume Next 'si aucune SpecialCell
    .SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = xlNone 'efface les couleurs des cellules vides
    .Replace " ", "", xlWhole 'efface l'espace
End With
End Sub

A+