For each / next

[julien974]

Bonjour,

J'ai besoin de votre aide concernant une petite macro toute simple mais que je n'arrive pas à créer...

Je souhaiterais que dans chaque onglet, toutes les cellules dont .Font.ColorIndex = 33, le résultat soit = à 0.

J'ai essayé mais ça ne fonctionne pas...

Sub hihi()
Dim C As Range
For Each C In Workbook

If C.ColorIndex = 33 Then
ActiveCell.Value = 0
End If

Next C


End Sub

Merci de votre aide,

Juli3n 974

 

[pierrejean]

Re : For each / next

bonjour julien

Sub hihi()
Dim C As Range
For Each sh In Sheets
 For Each C In sh.Cells
   If C.Interior.ColorIndex = 33 Then
    C.Value = 0
   End If
 Next C
Next sh
End Sub

mais ne soit pas trop pressé !!
l'examen de 65536*256 cellules par page peut prendre un certain temps

 

[julien974]

Re : For each / next

Bonjour pierrejean,

Je pense qu'elle fonctionne ms elle est trop trop lente...
Aurais tu une autra méthode plus rapide?
Sachant que les plages à traiter ne sont pas très grande...
de A1 à Z500

Merci,

Juli3n 974

 

[pierrejean]

Re : For each / next

Re

Je t'avais prevenu !!!

Sub hihi()
Dim C As Range
For Each sh In Sheets
 For Each C In sh.Range("A1:Z500")
   If C.Font.ColorIndex = 33 Then
    C.Value = 0
   End If
 Next C
Next sh
End Sub

Excuse moi je n'avais pas respecté le Font et mis Interior par habitude

 

[Guest]

Re : For each / next

Bonjour Julien, PierreJean

Essaie ceci, cela ira plus vite mais si tu as beaucoup de feuille et une grande plage de cellules occupées sur chaque feuille se sera de toute façon un peu long:

Sub MettreAjourCellulesCouleur33()
    Dim Plage As Range, plgCouleur As Range, Cell As Range
    Dim sh As Worksheet
 
    For Each sh In ThisWorkbook.Worksheets
        Set plgCouleur = Nothing
        Set Plage = Nothing
        Set Cell = Nothing
        'réduction de la plage
        For Each Plage In sh.UsedRange.Columns
            If IsNull(Plage.Font.ColorIndex) Then
                If plgCouleur Is Nothing Then
                    Set plgCouleur = Plage
                Else
                    Set plgCouleur = Application.Union(Plage, plgCouleur)
                End If
            End If
        Next
        'travail en ligne
        For Each Plage In sh.UsedRange.Rows
            If IsNull(Plage.Font.ColorIndex) Then
                For Each Cell In Application.Intersect(Plage, plgCouleur).Cells
                    If Cell.Font.ColorIndex = 33 Then
                        Cell.Value = 0
                    End If
                Next
            End If
        Next
    Next sh
End Sub

Adaptation d'une macro trouvée ici

A+

 

[Guest]

Re : For each / next

Re,

Je viens de me rendre compte que j'avais fait la même erreur que toi PierreJean Interior.ColorIndex au lieu de Font.Colorindex.

La macro de mon précédent post est corrigée, mais je ne l'ai pas testée avec Font. A voir....

[Edit] c'est fait j'ai testé et ça fonctionne.

A+

 

[skoobi]

Re : For each / next

Bonjour julien,
pierrejean
Hasco

Je propose ceci:

Sub Macro1()
Dim C As Range
For Each sh In Sheets
  Application.FindFormat.Font.ColorIndex = 33
  sh.UsedRange.Replace What:="", Replacement:="0", LookAt:=xlPart, SearchOrder:= _
      xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=False
Next sh
End Sub

Edit: petite modification dans le code

 

[pierrejean]

Re : For each / next

Hello skoobi

FindFormat a 1ere vue inconnu de Excel 2000 !!!

 

[skoobi]

Re : For each / next

Re,

A pierrejean,

Dans ce cas je présume que la boite de dialogue Rechercher/Remplacer ne te propose pas la sélection du format en cliquant sur le bouton option (à condition que ce bouton là existe!).

Bonne soirée,
Amitiés

 

[Guest]

Re : For each / next

Hello Skoobi
Hello PierreJean
@Skoobi:comme quoi y a pas que la flemme mais aussi l'encroutement qui avance!!!!!

A+

 

[Gruick]

Re : For each / next

Bonsoir à tous mes bienfaiteurs,

Avez-vous la solution pour appliquer celà à des Shapes (chacune ayant un nom) ?

du genre

dim s as (et là je ne sais pas quoi)
For each s in (là non plus)
   instructions sur leur couleur de chaque shape (là, je sais)
next s

Merci d'avance

Gruick

 

[Guest]

Re : For each / next

Hello Gruick

dim s as Shape
 
For each s in LaFeuille.Shapes
   instructions sur leur couleur de chaque shape (là, je sais)
next s

Te manquait pas grand chose!
A+

 

[skoobi]

Re : For each / next

Hello Skoobi
Hello PierreJean
@Skoobi:comme quoi y a pas que la flemme mais aussi l'encroutement qui avance!!!!!

A+

mort de rire hihi.
Faut faire gaffe, l'arthrose pointe son nez .

 

[pierrejean]

Re : For each / next

Re

@ skoobi

Effectivement la boite Rechercher/Remplacer n'evoque pas le format et n'a pas de bouton Option . Quant a Application , la liste ne comprend qu'un .Findfile
Attention les djeunes !! vous ne savez pas ce qui vous attend (a propos la flemme n'est pas une maladie !!)

 

[skoobi]

Re : For each / next

Re

@ skoobi

Effectivement la boite Rechercher/Remplacer n'evoque pas le format et n'a pas de bouton Option . Quant a Application , la liste ne comprend qu'un .Findfile
Attention les djeunes !! vous ne savez pas ce qui vous attend (a propos la flemme n'est pas une maladie !!)

Qu'est-ce que tu nous conseilles pierrejean afin de ne pas en arriver là?