XL 2016 VBA Remplacer valeur d'une cellule colorée

laurent3372

XLDnaute Impliqué

Supporter XLD

• 10 Mars 2020

• #2

VB:

Sub changer_valeur_couleur_cellule()
Range("A1:CC60000").Select
Dim Cel As Range
For Each Cel In Selection
    if cel.interior.color = 16749054 Then cel.Value = "0"
Next
End Sub

 

Vote positif 0 Vote négatif

eriiic

XLDnaute Barbatruc

• 10 Mars 2020

• #3

Bonjour à tous,

avec un .find sur format qui évite de boucler sur toutes les cellules.
Avec la taille de la plage à examiner plus l'écriture en une fois, il y aura un gros gain :

VB:

Sub cherche_Format()
    Dim c1 As Range, pl As Range, adr1 As String
    With Application
        .FindFormat.Clear
        .FindFormat.Interior.Color = 16749054
    End With
    With [A1:CC60000]
        Set c1 = .Find(What:="", SearchFormat:=True)
        If Not c1 Is Nothing Then
            adr1 = c1.Address: Set pl = c1
            Do
                Set c1 = .Find(What:="", After:=c1, SearchFormat:=True)
                If c1.Address <> adr1 Then Set pl = Union(pl, c1)
            Loop While Not c1 Is Nothing And c1.Address <> adr1
            pl.Value = 0
        End If
    End With
End Sub

eric

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 10 Mars 2020

• #4

Bonsoir le fil

Pas besoin de macro
CTRL+H =>Options / Format

Ce qui donne si vraiment VBA needed

VB:

Sub Macro1()
With Application.FindFormat.Interior
.Pattern = xlSolid: .Color = 16749054
End With
Application.FindFormat.Locked = True
Application.FindFormat.FormulaHidden = False
Cells.FindNext(After:=Cells(1)).Activate
Cells.Replace What:="", Replacement:="0", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=False
End Sub

NB: Mais plus simple avec CTRL+H et plus ergonomique

EDITION: Bonsoir eriiiic (Bing! Collision)
Désolé, je ne t'ai pas vu passé

 

Vote positif 0 Vote négatif

Solution

eriiic

XLDnaute Barbatruc

• 10 Mars 2020

• #5

Parce que j'étais en mode furtif... ;-)
Intéressant avec Ctrl+h, je n'y avais pas pensé.
Chez moi la ligne :

VB:

Cells.FindNext(After:=Cells(1)).Activate

plante.
Têtu je la met en commentaire.
Seulement après avoir fait le boulot, je ne sais pas où il part... Excel ramène le sablier, clignote la fenêtre plusieurs fois, et ça se termine par un 'excel ne répond plus' obligeant à une fermeture brutale...
Je retesterai après un reboot mais je reste pessimiste.
Sur 2019 et w7 tout ça.
eric

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 10 Mars 2020

• #6

Re

J'avoue n'avoir testé que qu'avec 3 cellules coloriées
Et bizarrement, je ne constate pas de plantage

PS: Le code sort tout droit du four de l'enregistreur.

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 10 Mars 2020

• #7

Re

Mon Excel 2013 a toussé mais le zéro a fini par gagné.
Mais pas de message d'erreur
Ci-dessous plus de 3 cellules pour tester

VB:

Sub PurpleRain()
Dim i&
Application.ScreenUpdating = False
For i = 1 To 1600
Select Case i Mod 2
Case 0
Columns(i).Cells(1).Resize(Application.RandBetween(1, 1600)).Interior.Color = 16749054
Case Else
End Select
Next
End Sub

 

Vote positif 0 Vote négatif

eriiic

XLDnaute Barbatruc

• 10 Mars 2020

• #8

La ligne ne tombe plus en erreur mais il part toujours dans les choux pour moi.

Si je remplace les Cells par une plage restreinte [A1:C11], là ça fonctionne.
Il doit partir dans une boucle sur toutes les cellules. Bizarre...
eric

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 10 Mars 2020

• #9

Re

Pour une fois, que c'est pas moi qui pleure
(voir le fil des Dictionnaires et Collections)
Si jamais, tu avais un éclairage sur pourquoi je pleure, je suis preneur

 

Vote positif 0 Vote négatif

eriiic

XLDnaute Barbatruc

• 10 Mars 2020

• #10

Bah, j'avais lu.
Si tu es sûr à 100% de ne pas passer en mémoire virtuelle, je ne vois pas quoi d'autre pourrait expliquer un tel écart.

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 10 Mars 2020

• #11

Re

Je ne comprends pas ce que tu entends par
"de ne pas passer en mémoire virtuelle".

Je me contente juste d'ouvrir Excel de coller les différents codes VBA et de les exécuter.
(W1064bits XL2013 et 4Go)

 

Vote positif 0 Vote négatif

eriiic

XLDnaute Barbatruc

• 11 Mars 2020

• #12

4 Go c'est peut-être juste.
Quand windows n'a plus assez de ram, il en crée une extension virtuelle sur le disque dur.
Tu imagines tout de suite le coup de frein que ça met, même si c'est un SSD.
Déjà si tu as un SSD tu peux configurer le système pour l'empêcher d'utiliser les HDD, qu'il n'aille que sur le SSD.
Sur le bouton windows tu recherches et lances "Informations système "
Note la ram et la mémoire virtuelle dispos.
Lance la proc excel et surveille si la ram dispo approche de 0 et si tu entames plus la mémoire virtuelle.
Si c'est le cas tu peux aller t'acheter la barette que tu aurais dû prendre au siècle dernier ;-)
eric

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 11 Mars 2020

• #13

Re

Justement pas de SSD
(J'envisage la chose mais chat échaudé craint l'eau froide)
Je viens de faire un systeminfo
Mémoire physique totale: 3 579 Mo
Mémoire physique disponible: 1 139 Mo
Mémoire virtuelle : taille maximale: 7 163 Mo
Mémoire virtuelle : disponible: 3 647 Mo
Mémoire virtuelle : en cours d'utilisation: 3 516 Mo
EDITION: Le même Excel et browser "éteints"
Mémoire physique totale: 3 579 Mo
Mémoire physique disponible: 1 896 Mo
Mémoire virtuelle : taille maximale: 7 163 Mo
Mémoire virtuelle : disponible: 5 192 Mo
Mémoire virtuelle : en cours d'utilisation: 1 971 Mo

PS: Est-ce que je peux te joindre à l'occasion en MP pour continuer la discussion vu que tout ceci n'a rien à voir avec la question du demandeur

 

Dernière édition: 11 Mars 2020

Vote positif 0 Vote négatif

eriiic

XLDnaute Barbatruc

• 11 Mars 2020

• #14

Bonjour,

oui tu peux, même sans demander ;-)
eric

 

Vote positif 0 Vote négatif

D

Djeje95

XLDnaute Nouveau

• 11 Mars 2020

• #15

Merci Laurent3372 pour une macro simple et merci Staple1600 pour la solution CTRL+H, je n'utilisais jamais les options.

 

Vote positif 0 Vote négatif