Réduction code

Bonjour le forum.

Est il possible de modifier le texte, car j'ai l'alphabet à faire.

Merci.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Range("v6:al23")
If Cell = "A" Then
Cell.Interior.ColorIndex = 41
End If
Next
For Each Cell In Range("v6:al23")
If Cell = "B" Then
Cell.Interior.ColorIndex = 41
End If
Next
For Each Cell In Range("v6:al23")
If Cell = "C" Then
Cell.Interior.ColorIndex = 41
End If
Next
End Sub

Bonjour,

Teste comme ceci

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Cell As Range
    Dim i%
      For Each Cell In Range("v6:al23")
        For i = Asc("A") To Asc("Z")
          If Cell = Chr(i) Then
            Cell.Interior.ColorIndex = 41
          End If
        Next
      Next
    End Sub

Bonjour le forum,M12.

c'est nickel,merci.

Bonjour Doudou, M, bonjour le forum,

Tout l'alphabet, majuscules/minuscules ou que les majuscules ? Le code ci-dessous ne traite que les majuscules :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cell As Range
Dim L As Byte

For Each Cell In Range("V6:AL23")
    For L = 65 To 90
        If Cell.Value = Chr(L) Then
            Cell.Interior.ColorIndex = 41
            Exit For
        End If
    Next L
Next Cell
End Sub

Ce qui m'étonne le plus c'est qu'il soit mis dans la procédure SelectionChange sans aucune restriction. Donc, il sera exécuté systématiquement chaque fois qu'une cellule sera sélectionnée. Cela va considérablement ralentir ton travail dans cet onglet !...

Bonjour, Salut M12, ThauThème !

Colore ainsi sur un évènement SelectionChange ne paraît pas un bon choix !

Soit tu le fais sur commande (toute la plage donc) :

Sub CouleurCellules()
    Dim c As Range
    For Each c In ActiveSheet.Range("A6:Vl23")
        If c.Value Like "[A-Z]" Then c.Interior.ColorIndex = 41
    Next c
End Sub

Soit tu le fais sur évènement Change :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim plg As Range, c As Range
    Set plg = Intersect(Target, Me.Range("A6:Vl23"))
    If Not plg Is Nothing Then
        For Each c In plg
            If c.Value Like "[A-Z]" Then c.Interior.ColorIndex = 41
        Next c
    End If
End Sub

NB- Il est toujours préférable pour ne pas se créer d'erreurs de lecture pour la suite de référencer une plage à partir de sa cellule supérieure gauche.

Cordialement.

Thau Theme,MFerrand

Merci à vous deux.

C'est encore moi.

Et pour enlever la couleur dans la grille de résultat SVP.

Re,

Le problème, c'est toujours le même

On balance une question avec un classeur qui (en définitif), ne va pas résoudre pas la question

voila le fichier

10mots-codes.xlsm (27.19 Ko)

Re,

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim plg As Range, c As Range
    Set plg = Intersect(Target, Me.Range("A6:Vl23"))
    If Not plg Is Nothing Then
        For Each c In plg
            If c.Value Like "[A-Z]" Then
                c.Interior.ColorIndex = 41
            Else
                c.Interior.ColorIndex = xlColorIndexNone
            End If
        Next c
    End If
End Sub

Ca ne fonctionne pas.

lorsque l'on enléve MATCH le bleu reste.

Merci.

Que me dis-tu ! ? Je n'ai pas coutume de fournir des proc. qui ne fonctionnent pas !

Ben non,quand je supprime MATCH (en dessous des numéros de 1 à 26),la couleur reste.

dans mon exemple,ca part aussitôt.

J'avais mal lu la plage dans ton 1er post et n'avais pas rectifié ! C'est fait ! A6:AL23

Tu aurais pu le rétablir.

y'arien de changé.

je supprime MATCH mais le bleu reste toujours;

Rechercher des sujets similaires à "reduction code"