Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Effacement cellules non colorées

  • Initiateur de la discussion Initiateur de la discussion NUEL
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

NUEL

XLDnaute Nouveau
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("A8😀S750")
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
 
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!
VB:
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
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
1 K
Réponses
3
Affichages
492
Réponses
11
Affichages
839
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
806
Réponses
2
Affichages
540
Réponses
1
Affichages
607
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…