Valider des données en VBA

Version imprimable

Bonjour,

Je suis en débutante en VBA.

Je dois vérifier que quand dans la colonne H il y a écrit oui, dans la colonne L il y a bien écrit oui. Sinon, il faut que je colore la ligne.

Voici mon code actuel :

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
Sub VérificationParitéBinômes()
    Dim Plg As Range
    Dim c As Range
    Dim i As Long
    Dim Msg As String
 
    ' définition de la plage de cellules
    Set Plg = Application.InputBox("Sélectionnez la plage.", Type:=8)
 
    ' coeur de la macro
    For Each c In Plg.Columns(1).Cells                    ' parcours
        If c <> c.Offset(0, 1) Then                                ' test
            Union(c, c.Offset(0, 0)).Interior.Color = vbYellow      ' coloriage
            i = i + 1                                               ' comptage
        End If
    Next
 
    ' préparation du message
    If i = 0 Then
        Msg = "Toutes les valeurs sont OK deux par deux."
    Else
        Msg = "Il y a des valeurs différentes sur " & i & " lignes !"
    End If
 
    ' affichage
    Z = MsgBox(Msg, vbInformation)
 
End Sub

J'espère que vous pourrez m'aider.

Cordialement,
Louise.

17/04/2015, 10h40
Invité

Bonjour,

Quel est votre problème ?

Cordialement.
17/04/2015, 10h47
louraluy

Bonjour,

Je n'arrive pas à faire la comparaison entre la colonne H et la colonne L ... et à faire que quand ca ne correspond pas ca ce colore

Une solution possible :

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
 
Sub VerificationPariteBinomes()
 
Dim Plage As Range
Dim Cellule As Range
 
Dim I As Long
Dim LigneDeTitre As Long
Dim DerniereLigne As Long
Dim DerniereColonne As Long
Dim ColonneReference As Long
Dim ColonneH As Long
Dim ColonneL As Long
 
 
    With ActiveSheet
 
        ' Définition de la plage de cellules
        LigneDeTitre = 1                                      ' A adapter si la ligne 1 n'est pas la ligne de titre
        ColonneReference = 1
        DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row  ' A modifier si la colonne A contient des cellules vides en fin de tableau
        DerniereColonne = .Cells(LigneDeTitre, .Columns.Count).End(xlToLeft).Column
 
        ColonneH = 8
        ColonneL = 12
 
        Set Plage = .Range(.Cells(LigneDeTitre + 1, ColonneReference), .Cells(DerniereLigne, ColonneReference))
 
       ' Set Plage = Application.InputBox("Sélectionnez la plage.", Type:=8)
 
        I = 0
        ' coeur de la macro
        For Each Cellule In Plage ' parcours
            If Cellule.Offset(0, ColonneH - ColonneReference) <> Cellule.Offset(0, ColonneL - ColonneReference) Then ' test
                .Range(Cellule, Cellule.Offset(0, DerniereColonne - ColonneReference)).Interior.Color = vbYellow ' coloriage
                I = I + 1 ' comptage
            End If
        Next
 
        ' Message
        If I = 0 Then
           MsgBox "Toutes les valeurs sont OK deux par deux.", vbInformation
        Else
           MsgBox "Il y a des valeurs différentes sur " & I & " lignes !", vbCritical
        End If
 
        Set Plage = Nothing
 
    End With
 
End Sub

J'ai remplacé l'Inputbox par une sélection de la plage en fonction de la position de la ligne de titre. J'ai enlevé les caractères signés ô, é... dans votre code.

Cordialement.

Je n'avais vu que dans le premier message, la condition était que la cellule de la colonne H devait être égale à "oui". Il faut ajouter une autre condition au code précédent :

Code:

1
2
3
4
5
6
7
 
       For Each Cellule In Plage ' parcours
            If Cellule.Offset(0, ColonneH - ColonneReference) <> Cellule.Offset(0, ColonneL - ColonneReference) And Cellule.Offset(0, ColonneH - ColonneReference) = "oui" Then ' test
                .Range(Cellule, Cellule.Offset(0, DerniereColonne - ColonneReference)).Interior.Color = vbYellow ' coloriage
                I = I + 1 ' comptage
            End If
      Next

Cordialement.

17/04/2015, 11h41
louraluy

c'est parfait ca fonctionne hyper bien ! Mille fois merci :)