XL 2016 # MFC applicable selon valeur autre cellule Vba

G

geoffreywolter

XLDnaute Nouveau
Bonjour, je cherche à ce que ce formatage soit applicable si la valeur de la cellule B (de la même ligne) est "A" , si la valeur est "B" le formatage conditionnel aura des valeurs differentes (au lieu de 2 à 9, 2 à 7 par exemple)
Merci.

Sub FormatageConditionnel()

Dim MaPlage As Range

Set MaPlage = Range("H:H")
MaPlage.FormatConditions.Delete
MaPlage.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=2", Formula2:="9"
MaPlage.FormatConditions(1).Interior.Color = RGB(0, 128, 0)

MaPlage.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=10", Formula2:="=15"
MaPlage.FormatConditions(2).Interior.Color = RGB(255, 255, 0)

MaPlage.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=16", Formula2:="=20"
MaPlage.FormatConditions(3).Interior.Color = RGB(255, 0, 0)
End With

End Sub
 
Trier par date Trier par votes
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir geoffrey,
Votre "End with" n'a pas sa place ici, donc votre macro est incomplète, ou pas testée.
Pourrait on obtenir un petit fichier test représentatif, c'est mieux pour comprendre et tester. :)
De plus pour le code utilisez les balises </> à droite de l'icone GIF, c'est plus lisible.

Alors au pif et sans test :
VB: 
Sub FormatageConditionnel()
Dim MaPlage As Range, Valeur
Set MaPlage = Range("H:H")
CelA = Array(2, 9, 10, 15, 16, 20)  ' Array des limites si A
CelB = Array(2, 7, 10, 11, 16, 18)  ' Array des limites si B
CelC = Array(1, 7, 8, 15, 16, 20)   ' Array des limites si C
Valeur = Cells(1, "B")
Select Case Valeur
    Case "A": MFC MaPlage, CelA
    Case "B": MFC MaPlage, CelB
    Case "C": MFC MaPlage, CelC
End Select
End Sub
Sub MFC(MaPlage, T)
MaPlage.FormatConditions.Delete

MaPlage.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=" & T(0), Formula2:="=" & T(1)
MaPlage.FormatConditions(1).Interior.Color = RGB(0, 128, 0)

MaPlage.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=" & T(2), Formula2:="=" & T(3)
MaPlage.FormatConditions(2).Interior.Color = RGB(255, 255, 0)

MaPlage.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=" & T(4), Formula2:="=" & T(5)
MaPlage.FormatConditions(3).Interior.Color = RGB(255, 0, 0)
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
G

geoffreywolter

XLDnaute Nouveau
sylvanu à dit:
Bonsoir geoffrey,
Votre "End with" n'a pas sa place ici, donc votre macro est incomplète, ou pas testée.
Pourrait on obtenir un petit fichier test représentatif, c'est mieux pour comprendre et tester. :)
De plus pour le code utilisez les balises </> à droite de l'icone GIF, c'est plus lisible.

Alors au pif et sans test :
VB: 
Sub FormatageConditionnel()
Dim MaPlage As Range, Valeur
Set MaPlage = Range("H:H")
CelA = Array(2, 9, 10, 15, 16, 20)  ' Array des limites si A
CelB = Array(2, 7, 10, 11, 16, 18)  ' Array des limites si B
CelC = Array(1, 7, 8, 15, 16, 20)   ' Array des limites si C
Valeur = Cells(1, "B")
Select Case Valeur
    Case "A": MFC MaPlage, CelA
    Case "B": MFC MaPlage, CelB
    Case "C": MFC MaPlage, CelC
End Select
End Sub
Sub MFC(MaPlage, T)
MaPlage.FormatConditions.Delete

MaPlage.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=" & T(0), Formula2:="=" & T(1)
MaPlage.FormatConditions(1).Interior.Color = RGB(0, 128, 0)

MaPlage.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=" & T(2), Formula2:="=" & T(3)
MaPlage.FormatConditions(2).Interior.Color = RGB(255, 255, 0)

MaPlage.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=" & T(4), Formula2:="=" & T(5)
MaPlage.FormatConditions(3).Interior.Color = RGB(255, 0, 0)
End Sub
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonsoir geoffreywolter, sylvanu,

Il faut doubler les MFC, par exemple pour la 1ère (verte) :
VB: 
Sub FormatageConditionnel()
Dim i&, PA As Range, PB As Range
With ActiveSheet
    For i = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
        If .Cells(i, "B") = "A" Then
            Set PA = Union(IIf(PA Is Nothing, .Cells(i, "H"), PA), .Cells(i, "H"))
        ElseIf .Cells(i, "B") = "B" Then
            Set PB = Union(IIf(PB Is Nothing, .Cells(i, "H"), PB), .Cells(i, "H"))
        End If
    Next
    .Columns("H").FormatConditions.Delete
End With
If Not PA Is Nothing Then
    PA.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=2", Formula2:="9"
    PA.FormatConditions(1).Interior.Color = RGB(0, 128, 0)
End If
If Not PB Is Nothing Then
    PB.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=2", Formula2:="7"
    PB.FormatConditions(1).Interior.Color = RGB(0, 128, 0)
End If
End Sub
A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
La macro adaptée pour les 3 plages PA PB PC :
VB: 
Sub FormatageConditionnel()
Dim i&, PA As Range, PB As Range, PC As Range
With ActiveSheet
    For i = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
        If .Cells(i, "B") = "A" Then
            Set PA = Union(IIf(PA Is Nothing, .Cells(i, "H"), PA), .Cells(i, "H"))
        ElseIf .Cells(i, "B") = "B" Then
            Set PB = Union(IIf(PB Is Nothing, .Cells(i, "H"), PB), .Cells(i, "H"))
        ElseIf .Cells(i, "B") = "C" Then
            Set PC = Union(IIf(PC Is Nothing, .Cells(i, "H"), PC), .Cells(i, "H"))
        End If
    Next
    .Columns("H").FormatConditions.Delete
End With
If Not PA Is Nothing Then
    PA.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=2", Formula2:="5"
    PA.FormatConditions(1).Interior.Color = RGB(0, 128, 0)
    PA.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=6", Formula2:="8"
    PA.FormatConditions(2).Interior.Color = RGB(255, 255, 0)
    PA.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=9", Formula2:="10"
    PA.FormatConditions(3).Interior.Color = RGB(255, 0, 0)
End If
If Not PB Is Nothing Then
    PB.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=3", Formula2:="7"
    PB.FormatConditions(1).Interior.Color = RGB(0, 128, 0)
    PB.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=8", Formula2:="11"
    PB.FormatConditions(2).Interior.Color = RGB(255, 255, 0)
    PB.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=12", Formula2:="15"
    PB.FormatConditions(3).Interior.Color = RGB(255, 0, 0)
End If
If Not PC Is Nothing Then
    PC.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=4", Formula2:="9"
    PC.FormatConditions(1).Interior.Color = RGB(0, 128, 0)
    PC.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=10", Formula2:="15"
    PC.FormatConditions(2).Interior.Color = RGB(255, 255, 0)
    PC.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=16", Formula2:="20"
    PC.FormatConditions(3).Interior.Color = RGB(255, 0, 0)
End If
 

Pièces jointes

  • Évaluation des fournisseurs_test.xlsm
    52.5 KB · Affichages: 3
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re, bonsoir Job,
Un essai en PJ en automatique. La macro s'active queand on sélectionne la feuille Fournisseurs.
Si on change en feuille Côte les couleurs ou limites alors les MFC seront remis à jour lors de la sélection de la feuille Fournisseurs. Ce qui permet facilement de modifier les limites ou couleurs sans toucher au VBA.
Avec :
VB: 
Sub Worksheet_Activate()
    ' Récupération du tableau d'évaluation et des couleurs
    With Sheets("Calcul côte d'évaluation")
        Vert = .[D25].Interior.Color
        Jaune = .[D26].Interior.Color
        Rouge = .[D27].Interior.Color
        T = .[A23:C39]
    End With
    ' Formules des 9 MFC et couleurs associées
    Dim F(1 To 9), Couleur(1 To 9)
    F(1) = "=ET(B8=""A"";H8>=" & T(3, 2) & ";H8<=" & T(3, 3) & ")": Couleur(1) = Vert
    F(2) = "=ET(B8=""A"";H8>=" & T(4, 2) & ";H8<=" & T(4, 3) & ")": Couleur(2) = Jaune
    F(3) = "=ET(B8=""A"";H8>=" & T(5, 2) & ";H8<=" & T(5, 3) & ")": Couleur(3) = Rouge
    F(4) = "=ET(B8=""B"";H8>=" & T(9, 2) & ";H8<=" & T(9, 3) & ")": Couleur(4) = Vert
    F(5) = "=ET(B8=""B"";H8>=" & T(10, 2) & ";H8<=" & T(10, 3) & ")": Couleur(5) = Jaune
    F(6) = "=ET(B8=""B"";H8>=" & T(11, 2) & ";H8<=" & T(11, 3) & ")": Couleur(6) = Rouge
    F(7) = "=ET(B8=""C"";H8>=" & T(15, 2) & ";H8<=" & T(15, 3) & ")": Couleur(7) = Vert
    F(8) = "=ET(B8=""C"";H8>=" & T(16, 2) & ";H8<=" & T(16, 3) & ")": Couleur(8) = Jaune
    F(9) = "=ET(B8=""C"";H8>=" & T(17, 2) & ";H8<=" & T(17, 3) & ")": Couleur(9) = Rouge
    ' Mise en place MFC
    Set MaPlage = Range("H8:H" & [H10000].End(xlUp).Row)
    MaPlage.FormatConditions.Delete
    For N = 1 To 9
        MaPlage.FormatConditions.Add Type:=xlExpression, Formula1:=F(N)
        MaPlage.FormatConditions(N).Interior.Color = Couleur(N)
    Next N
End Sub
 

Pièces jointes

  • Évaluation des fournisseurs_test.xlsm
    51.9 KB · Affichages: 0
Vote positif 0 Vote négatif
G

geoffreywolter

XLDnaute Nouveau
job75 à dit:
La macro adaptée pour les 3 plages PA PB PC :
VB: 
Sub FormatageConditionnel()
Dim i&, PA As Range, PB As Range, PC As Range
With ActiveSheet
    For i = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
        If .Cells(i, "B") = "A" Then
            Set PA = Union(IIf(PA Is Nothing, .Cells(i, "H"), PA), .Cells(i, "H"))
        ElseIf .Cells(i, "B") = "B" Then
            Set PB = Union(IIf(PB Is Nothing, .Cells(i, "H"), PB), .Cells(i, "H"))
        ElseIf .Cells(i, "B") = "C" Then
            Set PC = Union(IIf(PC Is Nothing, .Cells(i, "H"), PC), .Cells(i, "H"))
        End If
    Next
    .Columns("H").FormatConditions.Delete
End With
If Not PA Is Nothing Then
    PA.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=2", Formula2:="5"
    PA.FormatConditions(1).Interior.Color = RGB(0, 128, 0)
    PA.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=6", Formula2:="8"
    PA.FormatConditions(2).Interior.Color = RGB(255, 255, 0)
    PA.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=9", Formula2:="10"
    PA.FormatConditions(3).Interior.Color = RGB(255, 0, 0)
End If
If Not PB Is Nothing Then
    PB.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=3", Formula2:="7"
    PB.FormatConditions(1).Interior.Color = RGB(0, 128, 0)
    PB.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=8", Formula2:="11"
    PB.FormatConditions(2).Interior.Color = RGB(255, 255, 0)
    PB.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=12", Formula2:="15"
    PB.FormatConditions(3).Interior.Color = RGB(255, 0, 0)
End If
If Not PC Is Nothing Then
    PC.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=4", Formula2:="9"
    PC.FormatConditions(1).Interior.Color = RGB(0, 128, 0)
    PC.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=10", Formula2:="15"
    PC.FormatConditions(2).Interior.Color = RGB(255, 255, 0)
    PC.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="=16", Formula2:="20"
    PC.FormatConditions(3).Interior.Color = RGB(255, 0, 0)
End If
Cliquez pour agrandir...
Merci!!!!! ça fonctionne super j'ai juste ajouté le déclenchement automatique lors de changement dans la feuille
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bon en fait il n'y a pas besoin de VBA.

Il suffit de définir sur la plage H8:H76 3 MFC verte jaune rouge avec les 3 formules :
Code: 
=(B8="A")*(H8>=2)*(H8<=5)+(B8="B")*(H8>=3)*(H8<=7)+(B8="C")*(H8>=4)*(H8<=9)
=(B8="A")*(H8>=6)*(H8<=8)+(B8="B")*(H8>=8)*(H8<=11)+(B8="C")*(H8>=10)*(H8<=15)
=(B8="A")*(H8>=9)*(H8<=10)+(B8="B")*(H8>=12)*(H8<=15)+(B8="C")*(H8>=16)*(H8<=20)
Ah c'est mon 41000 ième message...

Bonne nuit.
 

Pièces jointes

  • Évaluation des fournisseurs_test.xlsx
    44.1 KB · Affichages: 2
Vote positif 0 Vote négatif

Discussions similaires

D
  • Résolu(e)
XL 2010 Mise en forme conditionnelle VBA
Réponses
11
Affichages
570
deva
D
H
  • Résolu(e)
XL 2016 [Résolu] VBA pour mise en forme conditionnelle
Réponses
2
Affichages
538
Hynnuh
H
P
  • Résolu(e)
Microsoft 365 Cellule avec liste déroulante ou pas, sous condition par macro
Réponses
5
Affichages
485
pat66
P
Chaton77
  • Résolu(e)
Microsoft 365 En VBA : Extraire le mois d'une date d'un tableau
Réponses
7
Affichages
259
Chaton77
Chaton77
J
  • Question
XL 2019 (Résolu) VBA - Mise en surbrillance de ligne (fonction dans ruban)
Réponses
3
Affichages
432
Julien_B
J
D
  • Question
Microsoft 365 VBA pour répéter - cacher 2 colonnes consécutives selon la valeur d'une cellule.
Réponses
4
Affichages
320
Didjo
D
R
  • Question
Microsoft 365 Couleur de fond de textbox [CLOTURE]
Réponses
2
Affichages
654
romubzh35
R
Dudu2
  • Suggestion
Texte Définir les propriétés d'une cellule ou d'un Range (couleurs, fonte, ..., valeur) dans une formule
Réponses
0
Affichages
857
Dudu2
Dudu2
gh4
  • Question
XL 2010 conversion en nombre depuis vba
Réponses
2
Affichages
712
gh4
gh4
gh4
  • Résolu(e)
XL 2010 couleur cellule en fonction des couleurs de MFC
Réponses
4
Affichages
639
gh4
gh4

Membres actuellement en ligne

24 membres et 293 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 626
Messages
2 111 276
Membres
111 089
dernier inscrit
olivier.hso