Variable dans une formule

Version imprimable

3 pièce(s) jointe(s)

Bonjour,

Je souhaiterai effectuer une MFC sur des cellules d'un tableur.

J'ai une cellule "Z16" dans lequel il y a un chiffre variable en l’occurrence on va dire 3.
En fonction de ce chiffre, un certains nombre de cellules se mettent en forme. je voudrai que si elles sont vides, les cellules s'affichent d'une certaine couleur et si elles sont remplies elles se remettent en blanc comme initialement. (Enfin transparent quoi)
J'ai réussis à mettre en place la première MFC mais lorsqu'il s'agit de faire l'autre partie (Celle ou ca se remet en transparent) je n'arrive pas à le faire ligne par ligne ! C'est tout le bloc qui se change

Etat actuel :
Pièce jointe 585585
Pièce jointe 585586

Etat souhaité :
Pièce jointe 585587

J'ai essayé avec la fonction With et la fonction If mais je dois mal les utiliser car rien ne se passe
Code:

1 2 3 4 5 6 7 8 9 10 11 Dim MaVariable As Range With Range(Cells(i + 20, 24), Cells(i + 20, 25)) Set MaVariable = Range(Cells(i + 20, 24), Cells(i + 20, 25)) .FormatConditions.Add Type:=xlExpression, Formula1:="=NBCAR(SUPPRESPACE(X21))=0" ' .FormatConditions.Add Type:=xlExpression, Formula1:="=NBCAR(SUPPRESPACE(" & MaVariable & "))=0" 'J'ai voulu tenté avec une variable mais ça fait tout planter et je n'ai plus aucun résultat With .FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = RGB(255, 199, 206) .TintAndShade = 0 End With End With
Code:

1 2 3 4 5 6 'Range(Cells(i + 20, 24), Cells(i + 20, 25)) 'Correspond à mes cellules qui s'ajoutent quand je renseigne le nombre de paramètres If IsEmpty(Range(Cells(i + 20, 24), Cells(i + 20, 25))) Then Range(Cells(i + 20, 24), Cells(i + 20, 25)).Interior.Color = RGB(255, 199, 206) Else Range(Cells(i + 20, 24), Cells(i + 20, 25)).Interior.Color = RGB(255, 255, 255)
Auriez-vous une idée de comment je peux faire en sorte de n'avoir que la cellule dans laquelle j'écrit qui se remet en transparent ?

Pour vous situer un peu le contexte, il s'agit d'une validation visuelle tant que la cellule est rougeâtre, l'utilisateur l'a oubliée.

Le code est plus gros que ça mais je sais pas si c'est réellement utile de vous le mettre en entier. Afin d'éviter un spam potentiellement inutile je le met pas dans un premier temps. Si vous en avez besoin je le mettrais lors de mon prochain post

Merci d'avance,
Cordialement,
Axel

Bonjour,

Quelque chose de ce genre devrait convenir:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Macro1()
    Dim i As Long, r As Range, f As String
    i = 4
    Set r = Range(Cells(20, 24), Cells(20 + i, 25))
    f = "=NBCAR(SUPPRESPACE(" & Cells(20, 24).Address(False, False) & "))=0"
    With r
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=f
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent2
            .TintAndShade = 0.399945066682943
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
    Set r = Nothing
End Sub

Il faut utiliser la même cellule dans la définition du Range et de la formule, dans l'exemple donné ci-dessus: Cells(20,24).

Pour info:
Cells(20,24).Address = $X$20
Cells(20,24).Address( True, False) = X$20
Cells(20,24).Address( False, False) = X20

Cordialement.

1 pièce(s) jointe(s)

Bonsoir !

Ca fonctionne merci beaucoup c'est exactement ce que je voulais !
Cependant j'ai deux cellules qui se colorent en bas sans aucune raison et qui ne se fusionnent pas !

Edit : J'ai du faire quelques modifications sur le fichier. l'adresse de mes cellules à donc changé donc j'ai du faire cette modification là mais je ne vois pas à quel moment je lui dis d'aller récupérer la couleur plus bas !
Pièce jointe 585725
Voila la code que j'ai utilisé
J'ai enlevé aussi le i=4 étant donné que c'est une variable

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
  Set r = Range(Cells(95, 24), Cells(95 + i, 25))
    f = "=NBCAR(SUPPRESPACE(" & Cells(95, 24).Address(False, False) & "))=0"
    With r
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=f
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent2
            .Color = RGB(255, 199, 206)
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
    Set r = Nothing

Et je met aussi le code entier si cela vous intéresse pour comprendre le fonctionnement du bousin

Code:

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, r As Range, f As String
 
    If Target.Address = "$Z$91" And IsNumeric(Target) Then 'si la cellule modifiée est bien Z16 et si la valeur est numérique
        Application.ScreenUpdating = False 'Evite les scintillements de l'affichage et augmente la vitesse d'exécution.
        Application.EnableEvents = False 'inhibe la détection de tout changement dans la feuille, ne rend pas la main au système
        Range("X96:Y100000").Clear 'on efface les précédents résultats
        For i = 1 To Target.Value 'on boucle de 1 jusqu'à la valeur saisie en Z16
 
            Range(Cells(i + 95, 24), Cells(i + 95, 25)).MergeCells = True 'fusion des cellules
        With Range(Cells(i + 95, 24), Cells(i + 95, 25))
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
    End With
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With
 
    Set r = Nothing
Next i 'boucle
        Application.EnableEvents = True 'rend la main au système afin qu'il puisse détecter toute modification sur la feuille
    Set r = Range(Cells(95, 24), Cells(95 + i, 25))
    f = "=NBCAR(SUPPRESPACE(" & Cells(95, 24).Address(False, False) & "))=0"
    With r
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=f
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent2
            .Color = RGB(255, 199, 206)
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
    Set r = Nothing
    End If
 
End Sub

Merci Eric,

Cordialement,
Axel

Cela devrait être ceci:

Code:

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, r As Range, f As String
    Debug.Print Target.Address, IsNumeric(Target)
    If Target.Address = "$Z$91" And IsNumeric(Target) Then 'si la cellule modifiée est bien Z16 et si la valeur est numérique
        Application.ScreenUpdating = False  'Evite les scintillements de l'affichage et augmente la vitesse d'exécution.
        Application.EnableEvents = False    'inhibe la détection de tout changement dans la feuille, ne rend pas la main au système
        Range("X96:Y100000").Clear          'efface les précédents résultats
        For i = 1 To Target.Value
        'boucle de 1 jusqu'à la valeur saisie en Z16
            Range(Cells(i + 95, 24), Cells(i + 95, 25)).MergeCells = True 'fusion des cellules
            With Range(Cells(i + 95, 24), Cells(i + 95, 25))
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                With .Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                End With
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
            End With
        Next i 'boucle
        Application.EnableEvents = True 'rend la main au système afin qu'il puisse détecter toute modification sur la feuille
        Set r = Range(Cells(96, 24), Cells(Target.Value + 95, 24))
        f = "=NBCAR(SUPPRESPACE(" & Cells(96, 24).Address(False, False) & "))=0"
        With r
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:=f
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent2
                .Color = RGB(255, 199, 206)
            End With
            .FormatConditions(1).StopIfTrue = False
        End With
        Set r = Nothing
    End If
End Sub

Cordialement

03/12/2020, 20h40
Patate3181

Ah oui c'est parfait !
Effectivement je n'avais pas pensé à mettre deux cellules différentes dans les Cells pour moi ca devait tout le temps être la même pour que ça fonctionne et que ça garde une cohérence !

Quoi qu'il en soit, vraiment merci beaucoup c'est résolu !

Bonne soirée !
Cordialement,
Axel