XL 2016 Effacement cellules non colorées

[NUEL]

Bonjour
Je suis novice dans l'utilisation d'excel et le VB.
J'ai réalisé un tableau commençant à la cellule A8 et allant jusqu'à le cellule DS750 mais ça pourrait être beaucoup plus (ex : DS10000) si besoin.
Je dois laissé dans ce tableau uniquement les valeurs dont la cellule est colorée, les autres sont effacées.
J'ai réalisé un petit code mais il est long à l'exécution, quelqu'un peut il m'aider pour une solution plus rapide
Voici le code :
Sub REV()

Dim C As Range, Rg As Range
With Worksheets("CSN Data")
.Select

For Each C In .Range("A8S750")
If C.Interior.ColorIndex = xlNone Then
If Rg Is Nothing Then
Set Rg = C
Else
Set Rg = Union(Rg, C)
End If
End If
Next
Rg.Select
Selection.ClearContents
End With
Sheets("CSN Data").Select
Range("A1").Select
End Sub

Merci pour votre aide

 

[mapomme]

Bonjour @NUEL et bienvenu sur XLD ,

Voir une tentative dans le fichier joint. Le code est dans Module1.

XLD permet de joindre un fichier (anonymisé) représentatif de votre problème et de la solution désirée. N'hésitez pas en joindre un. Cela évitera aux répondeurs de devoir en fabriquer un ex nihilo pour pouvoir testez leurs solutions. Merci

Sur mon PC pour 750 lignes, la durée est environ 1,6 s et pour 10 000 lignes elle monte à environ 22 s.

• pour testez sur le nombre de ligne de votre choix, modifier la valeur de la constante NbrLignes au début du code puis cliquez sur Init
• ensuite cliquez sur le bouton Hop!

Const NbrLignes = 10000

Sub REV()
Dim i&, t, xcell, deb As Double
deb = Timer
  Application.ScreenUpdating = False
  With Worksheets("CSN Data").Range("a8:ds" & NbrLignes)
    For i = 1 To .Columns.Count
      t = .Columns(i).Value
      For Each xcell In .Columns(i).Cells
        If xcell.Interior.ColorIndex = xlNone Then t(xcell.Row - 7, 1) = Empty
      Next xcell
      .Columns(i).Value = t
    Next i
  End With
MsgBox Format(Timer - deb, "0.00\ sec.")
End Sub

 

[NUEL]

Bonjour mapomme,
Merci pour le coup de main ça fonctionne beaucoup plus vite qu'avec le code que j'avais écrit
Merci

 

[mapomme]

Re @NUEL,

Il faut savoir que les opérations UNION et INTERSECT sur les range prennent énormément de temps. Il vaut mieux les éviter si elles portent sur de nombreux range ou cellule.