xl 2000 condition if et and

[XIBOOX]

Bonsoir J'aimerai pouvoir colorer une cellule en fonction de la valeur et selon un critère
pour prévoir des activités dans un centre de loisir je dois distinguer dans un listing les enfants selon fille garçon mineur majeur avec quatre couleurs en l2 l3 m2 m3

si fille mineur alors l2.Interior.ColorIndex sinon m2.Interior.ColorIndex
si garcon mineur alors l3.Interior.ColorIndex sinon m3.Interior.ColorIndex

Option Explicit
Dim plage As Range, cellule As Range
Private Sub Worksheet_Change(ByVal Target As Range)
  Set plage = Application.Union(Range("J7:U33"), Range("V7:V33"))
  For Each cellule In plage
    cellule.Interior.ColorIndex = xlNone
  Next
  For Each cellule In plage
    If cellule = "F" And cellule.Offset(1, 3) < 17 Then cellule.Interior.ColorIndex = [l2].Interior.ColorIndex
    
    If cellule = "M" And cellule.Offset(1, 3) < 17 Then cellule.Interior.ColorIndex = [l3].Interior.ColorIndex
    
  Next
  
End Sub

j'utilise le code suivant mais j'arrive pas a faire le "sinon"

 

[Hulk]

Re : xl 2000 condition if et and

Hello,

Essaie ça...

Dim plage As Range, cellule As Range
Private Sub Worksheet_Change(ByVal Target As Range)
  Set plage = Application.Union(Range("J7:U33"), Range("V7:V33"))
  For Each cellule In plage
    cellule.Interior.ColorIndex = xlNone
  Next
  For Each cellule In plage
    If cellule = "F" And cellule.Offset(1, 3) < 17 Then
        cellule.Interior.ColorIndex = [l2].Interior.ColorIndex
    ElseIf cellule = "M" And cellule.Offset(1, 3) < 17 Then
        cellule.Interior.ColorIndex = [l3].Interior.ColorIndex
    Else
        'sinon
    End If
  Next

 

[XIBOOX]

Re : xl 2000 condition if et and

je seche
je comprend pas comment marche elseif

 

[kjin]

Re : xl 2000 condition if et and

Bonjour,
Il y a une touche F1 dans VBA !
Une autre approche

Option Explicit
Dim plage As Range, cellule As Range
Private Sub Worksheet_Change(ByVal Target As Range)
Set plage = Application.Union(Range("J7:U33"), Range("V7:V33"))
plage.Cells.Interior.ColorIndex = xlNone
For Each cellule In plage
    Select Case cellule
    Case "F"
        Select Case cellule.Offset(1, 3)
        Case Is < 17
            cellule.Interior.ColorIndex = [L2].Interior.ColorIndex
        Case Else
            cellule.Interior.ColorIndex = [M2].Interior.ColorIndex
        End Select
    Case "M"
        Select Case cellule.Offset(1, 3)
        Case Is < 17
            cellule.Interior.ColorIndex = [L3].Interior.ColorIndex
        Case Else
            cellule.Interior.ColorIndex = [M3].Interior.ColorIndex
        End Select
    End Select
Next
  
End Sub

Plusieurs choses que je ne comprends pas :
- pourquoi une macro événementielle
- si macro événementielle il y a, pourquoi ne pas limiter la plage de fonctionnement
- l'offset dans le code puisqu'à priori toutes les cellules de la plage sont concernées
- euh la majorité...c'est pas 18 ans !
A+
kjin

 

[XIBOOX]

Re : xl 2000 condition if et and

BOnjour Kjin
Plusieurs choses que je ne comprends pas :
- j'utilise une macro événementielle pour mettre a jour le tableau à chaque saisie
- si macro événementielle il y a, pourquoi ne pas limiter la plage de fonctionnement
ne sachant pas définitivement le nombre total d'enfant je ne souhaite pas limiter la plage a moins que tu connais une autre méthode ....

- l'offset dans le code puisqu'à priori toutes les cellules de la plage sont concernées
l'offset me sert pour l'age
- euh la majorité...c'est pas 18 ans ! ça dépend des loustic

 

[kjin]

Re : xl 2000 condition if et and

re,
Et avec ça, on ne sait toujours pas si les solutions proposées fonctionnent !
Tu peux limiter le fonctionnement aux colonnes concernées et à la cellule active plutôt que de recalculer toutes la feuille à chaque saisie !
Mais un fichier exemple indiquant la structure de la feuille est nécessaire
A+
kjin

 

[XIBOOX]

Re : xl 2000 condition if et and

je viens de teste
mais je n'ai pas le résultat souhaite
ci joint mon fichier

 

[XIBOOX]

Re : xl 2000 condition if et and

Bonjour
j'ai tente une autre approche :

Sub rets()
Dim j As Byte, x As Byte, v As Byte
Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, f As Integer, g As Integer, h As Integer, r As Integer
Dim o, p As Integer

Dim rng As Range

tabonglet = Array("F", "M")

For j = 0 To UBound(tabonglet)


onglet = tabonglet(j)
    a = 0
    b = 0
    c = 0
    d = 0
    e = 0
    f = 0
    g = 0
    h = 0
    r = 0
    o = 0
    p = 0
        
    With Worksheets("feuil1")
        .Range("k7").Activate
        .Range("k7").End(xlDown).Select
        Set rng = ActiveCell
        For n = 7 To 33 'rng.Row
                  
            If .Range("k" & n) = "F" And .Range("m" & n) < 17 Then .Range("k" & n).Interior.ColorIndex = [L2].Interior.ColorIndex
            If .Range("k" & n) = "F" And .Range("m" & n) > 17 Then .Range("k" & n).Interior.ColorIndex = [N2].Interior.ColorIndex
            If .Range("k" & n) = "M" And .Range("m" & n) < 17 Then .Range("k" & n).Interior.ColorIndex = [L3].Interior.ColorIndex
            If .Range("k" & n) = "M" And .Range("m" & n) > 17 Then .Range("k" & n).Interior.ColorIndex = [N3].Interior.ColorIndex
            
            If .Range("o" & n) = "F" And .Range("q" & n) < 17 Then .Range("o" & n).Interior.ColorIndex = [L2].Interior.ColorIndex
            If .Range("o" & n) = "F" And .Range("q" & n) > 17 Then .Range("o" & n).Interior.ColorIndex = [N2].Interior.ColorIndex
            If .Range("o" & n) = "M" And .Range("q" & n) < 17 Then .Range("o" & n).Interior.ColorIndex = [L3].Interior.ColorIndex
            If .Range("o" & n) = "M" And .Range("q" & n) > 17 Then .Range("o" & n).Interior.ColorIndex = [N3].Interior.ColorIndex
            
            If .Range("s" & n) = "F" And .Range("u" & n) < 17 Then .Range("s" & n).Interior.ColorIndex = [L2].Interior.ColorIndex
            If .Range("s" & n) = "F" And .Range("u" & n) > 17 Then .Range("s" & n).Interior.ColorIndex = [N2].Interior.ColorIndex
            If .Range("s" & n) = "M" And .Range("u" & n) < 17 Then .Range("s" & n).Interior.ColorIndex = [L3].Interior.ColorIndex
            If .Range("s" & n) = "M" And .Range("u" & n) > 17 Then .Range("s" & n).Interior.ColorIndex = [N3].Interior.ColorIndex
            
            
            
            
       Next n
         End With
 

  
Next j


Set plage = Range("k7:U33") 'Application.Union(Range("k7:U33"), Range("V7:V33"))
Dim cellule As Range

For Each cellule In plage
If cellule.Interior.ColorIndex = [L2].Interior.ColorIndex Then a = a + 1
If cellule.Interior.ColorIndex = [L3].Interior.ColorIndex Then b = b + 1
If cellule.Interior.ColorIndex = [N2].Interior.ColorIndex Then c = c + 1
If cellule.Interior.ColorIndex = [N2].Interior.ColorIndex Then d = d + 1

Next

  [L2] = a
  [L3] = b
  [N2] = c
  [N3] = d
End Sub

mais le nbre de garçon majeur est faussé
je ne vois pas mon erreur....

ci joint mon fichier
il faut lancer la macro rets

 

[XIBOOX]

Re : xl 2000 condition if et and

comment compter le nbre de cellules colorées?

 

[Habitude]

Re : xl 2000 condition if et and

If cellule.Interior.ColorIndex = [L2].Interior.ColorIndex Then a = a + 1
If cellule.Interior.ColorIndex = [L3].Interior.ColorIndex Then b = b + 1
If cellule.Interior.ColorIndex = [N2].Interior.ColorIndex Then c = c + 1
If cellule.Interior.ColorIndex = [N2].Interior.ColorIndex Then d = d + 1

Tu as mis 2 fois [N2]

 

[XIBOOX]

Re : xl 2000 condition if et and

OUI BIEN VU MERCI Habitude
j'ai relu le code pourtant ....
désole c'est résolu !!!!!