Discussion :

[borisp]

Bonjour,

Je dois remettre un onglet comportant un nombre important de cellule en fonction de leur couleur. Il ne s'agit pas d'une plage fixe malheureusement.

Le code que j'ai trouvé prend énormément de temps :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
   Sheets("E3_Affectation_CI&PD").Select
For Each Cellule In Range("g8:BZ329")
         If ActiveCell.Interior.ColorIndex = 36 Then
         ActiveCell.Value = ""
End If
Next
 
End Sub

Auriez-vous une autre astuce pour accélérer le traitement?

J'ai pensé à mettre une autre condition : si la valeur de la cellule est vide. Mais la macro ne fait plus rien...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
    Sheets("E3_Affectation_CI&PD").Select
For Each Cellule In Range("g8:BZ329")
         If ActiveCell.Interior.ColorIndex = 36 And ActiveCell.Value <> "" Then
 
         ActiveCell.Value = ""
End If
Next
 
End Sub

Merci par avance pour votre aide

[casefayere]

Bonjour,
déjà, au départ, ton code devrait être

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Dim Cellule As Range
With Sheets("E3_Affectation_CI&PD")
   For Each Cellule In .Range("g8:BZ329")
     If Cellule.Interior.ColorIndex = 36 Then
       Cellule.Value = ""
     End If
  Next Cellule
End With

Pour la rapidité, je vais regarder, sans garantie

[borisp]

Merci!

[casefayere]

en respectant tes limites, essayes ce code maxi 1 seconde

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub couleurs()
Dim Cellule As Range, x As Long, y As Long
Dim Tb(), tb1
With Sheets("E3_Affectation_CI&PD")
  tb1 = .Range("g8:BZ329")
  ReDim Tb(1 To UBound(tb1, 1), 1 To UBound(tb1, 2))
  For x = 7 To 72
    For y = 8 To 329
      Tb(y - 7, x - 6) = .Cells(y, x).Interior.ColorIndex
    Next y
  Next x
  For x = 1 To UBound(tb1, 2)
    For y = 1 To UBound(tb1, 1)
      If Tb(y, x) = 36 Then tb1(y, x) = ""
    Next y
  Next x
  .Range("G8").Resize(UBound(tb1, 1), UBound(tb1, 2)) = tb1
End With
End Sub

dis-moi quoi car vite fait

Edit :code modifié (un peu plus logique)

[borisp]

Au top ça marche impec merci infiniment!

[borisp]

En fait cela marche bien mais la fonction efface les formules de mon tableau sans les recopier. Les formules sont copiées en dur...
Est-ce que tu aurais une parade casefayere? Merci beaucoup

[casefayere]

Bonjour, je ne savais pas qu'il y avais des formules donc, il faudrait passer par une boucle pour remplir "tbl",comme "tb", conclusion temps de traitement légèrement allongé, mais la parade consiste à ne prendre dans "'tbl" que la plage sans les formules, pour ça il me faudrait des indications supplémentaires, (ou sont les formules, etc.)

[borisp]

LE problème est qu'il y a des formules à plusieurs endroits assez variables...mais avec des couleurs identifiées.
Est-ce qu'il est possible de garder les formules en fonction de certaines couleurs ?

Il s'agit des couleurs 15 et 25.


Merci beaucoup

[casefayere]

là, tu compliques le travail, peux-tu envoyer un fichier bidon, je regarderai sans promesse de résultat, à moins que quelqu'un plus aguerri puisse te donner une bonne piste

[borisp]

Le voici merci.

J'ai laissé juste l'onglet en question. La macro correspondante est "effacer" ou Module 3 dans le code.

Les formules ont sautées mais en gros ce sont les celulles bleues foncées et grises

Merci ça serait vraiment top!!

[casefayere]

Si tu gardes toutes les formules, la solution est plus simple que ce que j'aurais pu croire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Option Explicit'je me suis permi
Sub Effacer()
Dim Cellule As Range, x As Long, y As Long
Dim Tb(), Tb1, Dcel As Long
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'msgbox d'alerte
 
Dim msgValue
msgValue = MsgBox("Attention, vous allez effacer toutes les données saisies", vbOKCancel + vbExclamation, "ATTENTION !")
If msgValue = vbCancel Then
  Exit Sub
End If
 
'Remise à zéro de l'onglet E3_Affectation_CI&PD
 
With Sheets("E3_Affectation_CI&PD")
Dcel = .Range("F" & .Rows.Count).End(xlUp).Row
  Tb1 = .Range("G8:AG" & Dcel).Formula
  ReDim Tb(1 To UBound(Tb1, 1), 1 To UBound(Tb1, 2))
  For x = 7 To 33
    For y = 8 To Dcel
      Tb(y - 7, x - 6) = .Cells(y, x).Interior.ColorIndex
    Next y
  Next x
  For x = 1 To UBound(Tb1, 2)
    For y = 1 To UBound(Tb1, 1)
      If Tb(y, x) = 36 Then Tb1(y, x) = ""
    Next y
  Next x
 .Range("G8").Resize(UBound(Tb1, 1), UBound(Tb1, 2)) = Tb1
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
 
End Sub

essayes et dis-moi

[borisp]

Bonjour et merci beaucoup pour ta réponse, je n'ai pu essayer que ce matin.

Le code me renvoi une erreur sur la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dcel = .Range("F" & .rows.Count).End(xlUp).row

Il indique une "invalid or unqualified reference" sur .rows.

C'est une erreur de déclaration de variable?

Merci encore pour ton aide précieuse

[casefayere]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dcel = .Range("F" & .rows.Count).End(xlUp).row

la syntaxe est correcte d'autant qu'avant on spécifie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With Sheets("E3_Affectation_CI&PD")

de plus Dcel est bien déclaré en long, vérifie le nom de ta feuille et ce que contient la colonne F, j'avais vérifié mon code donc quelque-chose a du changer entre temps

[borisp]

Yes c'est bon au temps pour moi j'avais effacé cette ligne par erreur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With Sheets("E3_Affectation_CI&PD")

Je te remercie vivement pour tout