Macro de controles

Save92

XLDnaute Nouveau
Bonjour je suis actuellement sur une macro ou je dois effectuer differents controles sur plusieurs données. Je suis débutant en VBA mais j'ai déjà trouvé quelques pistes, je vous demande conseil pour ce que je n'ai pas trouver ou que je n'arrive pas à utiliser. Merci.
Tous d'abord j'ai deux colonnes (E et F) avec des dates, la premiere avec les dates de début (obligatoire) et la deuxieme les dates de fin (facultatif). Je dois controler que les dates de debut sont non vide et que le format des dates est respecter (A peu près reussi)
Code:
Sub TestDate()
Dim rg As Range
Dim bValid As Boolean

'on commence au début de la liste de date
Set rg = ActiveSheet.Range("E1")

bValid = True          'vrai par défaut, date format  valide
Do Until IsEmpty(rg)    'on suppose qu'il n'y a pas de lignes vides
   
   
    'vérifier si c'est une date valide ou non
    If Not IsDate(rg) Then
        rg.Interior.ColorIndex = 3  'en rouge
        bValid = False  'on met à faux
    End If
   
    'vérifier si la date ne correspond pas au mois
    On Error Resume Next
    If bValid Then  'si format date valide alors
        If Month(rg) <> ActiveSheet.Range("H1") And _
            Year(rg) <> ActiveSheet.Range("J1") Then
            rg.Interior.ColorIndex = 6  'en jaune
End If
    End If

    bValid = True
    Set rg = rg.Offset(1, 0)
Loop
End Sub

Par contre je n'arrive pas à trouver le moyen de dire : Si la date de fin (sur la colonne F donc à droite) est remplie alors la date de début doit etre inférieure ou égale à la date de fin.
Merci
 

nyko283

XLDnaute Occasionnel
Re : Macro de controles

bonjour Save, le forum

VB:
Sub TestDate()
Dim rg As Range
Dim bValid As Boolean

'on commence au début de la liste de date
Set rg = ActiveSheet.Range("E1")

bValid = True          'vrai par défaut, date format  valide
Do Until IsEmpty(rg)    'on suppose qu'il n'y a pas de lignes vides
   
   
    'vérifier si c'est une date valide ou non
    If Not IsDate(rg) Then
        rg.Interior.ColorIndex = 3  'en rouge
        bValid = False  'on met à faux
    End If
   
    'vérifier si la date ne correspond pas au mois
    On Error Resume Next
    If bValid Then  'si format date valide alors
        If Month(rg) <> ActiveSheet.Range("H1") And _
            Year(rg) <> ActiveSheet.Range("J1") Then
            rg.Interior.ColorIndex = 6  'en jaune
End If
    End If
    If rg.Offset(0, 1).Value <>"" and rg > rg.Offset(0, 1).Value Then
    MsgBox " pas la bonne date"
        'met ici le code choisi au cas ou la date de fin est inférieur a celle du debut
    rg.Offset(0, 1).Select
    End If    bValid = True
    Set rg = rg.Offset(1, 0)
Loop
End Sub
 

Save92

XLDnaute Nouveau
Re : Macro de controles

Merci nyko283, par contre serait il possible d'inclure dans la MsgBox le(s) numéro(s) de la ligne ou il y a l'(es) erreur(s). Désoler si ce sont des question "Nulle" mais je débute vraiment et ayant travailler du C, c'est complètement différent ^^.
 

nyko283

XLDnaute Occasionnel
Re : Macro de controles

Bonjour Save,

alors tu peut remplcer le code par celui ci :

VB:
Sub TestDate()
Dim rg As Range
Dim bValid As Boolean
Dim tabloLigne() As Long, i As Long, s As Long
Dim monmessage As String
monmessage = " Les dates saisies dans les lignes suivantes ne sont pas valides : "
i = 0
'on commence au début de la liste de date
Set rg = ActiveSheet.Range("E1")

bValid = True          'vrai par défaut, date format  valide
Do Until IsEmpty(rg)    'on suppose qu'il n'y a pas de lignes vides
 
   
    'vérifier si c'est une date valide ou non
   If Not IsDate(rg) Then
        rg.Interior.ColorIndex = 3  'en rouge
       bValid = False  'on met à faux
   End If
   
    'vérifier si la date ne correspond pas au mois
   On Error Resume Next
    If bValid Then  'si format date valide alors
       If Month(rg) <> ActiveSheet.Range("H1") And _
            Year(rg) <> ActiveSheet.Range("J1") Then
            rg.Interior.ColorIndex = 6  'en jaune
End If
    End If
    rg.Offset(0, 1).Interior.ColorIndex = xlNone ' retire la couleur des précédentes vérifications
    If rg.Offset(0, 1).Value <> "" And rg > rg.Offset(0, 1).Value Then
    i = i + 1
    rg.Offset(0, 1).Interior.ColorIndex = 3 ' met la cellules en rouge si la date est inférireur
    ReDim Preserve tabloLigne(1, i) ' redimensionne la variable tableau en gardant les données qui se trouverait déja dans le tableau
    tabloLigne(1, i) = rg.Row ' met dans le tableau la ligne concernée
    End If
    bValid = True
    Set rg = rg.Offset(1, 0)
   
Loop
If i <> 0 Then
    For s = 1 To i
    monmessage = monmessage & " " & tabloLigne(1, s) & ", " récupère tous les numéros de ligne non valide et les intègre au message.
    Next s
    monmessage = Left(monmessage, Len(monmessage) - 2) & "." ' retire la derniere virgule et remplace par 1 point
MsgBox monmessage ' affiche le message formé.
End If
End Sub
 

Save92

XLDnaute Nouveau
Re : Macro de controles

Merci beaucoup, j'ai encore une chose à voir, j'ai reussi à faire un controle sur le nombre de caractères d'une colone avec :
Code:
Sub Control_Nbr_Charac()
Dim i As Integer
Dim str As String
Dim rg As Range

Set rg = ActiveSheet.Range("A2")
i = 0

Do Until IsEmpty(rg)
    str = rg.Offset.Value
    i = Len(str)
    If i = 9 Then
    rg.Interior.ColorIndex = 6
    Else
    rg.Interior.ColorIndex = 3
    End If
    Set rg = rg.Offset(1, 0)
    rg.Select
Loop

End Sub
Sa marche plutot bien (j'ai repris ton code pour les couleurs merci encore :D), par contre je dois vérifier deux autres colonnes(B et C) avec comme contrainte,
Si il y a un numero renseigné dans la colonne C (de 7 caractères à vérifier) alors il doit y avoir obligatoirement le numero de renseigner dans la colonne B (de 5 caractères). Par contre il se peut qu'il n'y est que un numéro dans la colonne B (5caracteres toujours) mais pas dans la C. Je voudrais juste mettre ne rouge lorsqu'il y a une erreur. Je dois réutiliser une variable comme tu la fait (rg.offset?:confused:)
Merci encore j'apprend beaucoup :D
 

nyko283

XLDnaute Occasionnel
Re : Macro de controles

Bonsoir Save,

en utilisant le Offset, cela te permettra de faire tes verification dans la meme boucle que celle que tu utilise pour vérifier ta colonne A,
Je ne sais pas si tu veux vérifier tes dates en meme temps que cette deuxième partie mais tu peut .
en l'integrant dans ta boucle,tu va gagné en temps d'execution du code.
Sur un petit tableau cela n'aura pas beaucoup de conséquence mais si tu arrive a une centaine de ligne de plus...;)
j'ai légèrement raccourcci le code que tu as poster juste avant

VB:
sub Control_Nbr_Charac()

Dim rg As Range

For Each rg In Range("A2:A" & Range("A65536").End(xlUp).Row)
   'verifie la colonne A
    If Len(rg.Value) = 9 Then rg.Interior.ColorIndex = 6 Else rg.Interior.ColorIndex = 3
 Next rg
end sub

et donc si integrer dans le code du 1er test :

VB:
Sub Test()

Dim rg As Range
Dim monmessage As String
'-----------------------
monmessage = "Les dates saisies dans les lignes suivantes ne sont pas valides : "
Set rg = ActiveSheet.Range("A1")
'-----------------------
'on commence au début de la liste de date
Range("A1:E" & Range("A65536").End(xlUp).Row).Interior.ColorIndex = xlNone ' retire toutes les couleurs du test précédent
        
For Each rg In Range("A2:A" & Range("A65536").End(xlUp).Row)
    If Len(rg) = 9 Then rg.Interior.ColorIndex = 6 Else rg.Interior.ColorIndex = 3 'verifie la colonne A
    'verifie la colonne E
    If Not IsDate(rg.Offset(0, 4)) Then 'vérifier si c'est une date valide ou non
        rg.Offset(0, 4).Interior.ColorIndex = 3  'en rouge
    Else
        If Month(rg.Offset(0, 4)) <> ActiveSheet.Range("H1") And _
            Year(rg.Offset(0, 4)) <> ActiveSheet.Range("J1") Then
            rg.Offset(0, 4).Interior.ColorIndex = 6  'en jaune
        End If
    End If
    'verifie la colonne F
    If rg.Offset(0, 5) <> "" And Not IsDate(rg.Offset(0, 5)) Or rg.Offset(0, 4) > rg.Offset(0, 5) Then
        
        rg.Offset(0, 5).Interior.ColorIndex = 3 ' met la cellules en rouge si la date est inférireur
        monmessage = monmessage & " " & rg.Row & ", " ' generation du message pour la colonne F uniquement
    End If
    Set rg = rg.Offset(1, 0)
Next rg

If Len(monmessage) > 66 Then MsgBox Left(monmessage, Len(monmessage) - 2) & "." ' affiche le message formé.
' peut etre supperflu car les cellules sont deja en rouge...
End Sub
donc on voit ici que le code pour "controler" ta colonne A ne représente plus q'une ligne;)
je me suis permis de faire un peu le ménage dans ce code,

Voyant que tu comprend le principe,je te laisse le soin donc,d'essayer de te faire les contrôle des colonne B et C mais si tu bloque je te donnerai un petit coup de main bien entendu.
 
Dernière édition:

Save92

XLDnaute Nouveau
Re : Macro de controles

Merci beaucoup je vais essayer de faire le test pour les colonnes B et C, je part du principe de verifier la colonne C lorsque les valeurs sont diferentes de "" et donc de vérifier la colonne B sur la meme ligne. Par contre si je vérifie la colonne B je reverifirais automatiquement les lignes que j'ai vérifier avec le test de la colonne C? Ou il y à un moyen de les "sauter" puisque le test auras déjà été effectué? Mais c'est plus du détail je penses ^^.
 

nyko283

XLDnaute Occasionnel
Re : Macro de controles

Bonjour Save,

Peu importe le sens que tu choisi, juste l'imbrication des test changera mais les test seront les meme, tu peut partir sur le meme principe que le controle des colonnes E et F, à savoir tous controler dans une meme boucle afin de ne pas faire 2 fois les meme cellules.

Donc tu controle chaque ligne de la colonne C suivant si vide ou non et si a la longueur requis et de la, tu détermine les test a faire sur la colonne B
Par exemple si colonne C = vide alors on verifie si la longueur de B est egale à 0 ou à 5 ou alors si C n'est pas vide alors il faut que B fasse 5 de long.

Donc c'est exactement ce que tu proposait sauf que j'ajoute que quand C est vide de controler quand meme B.
 
Dernière édition:

Save92

XLDnaute Nouveau
Re : Macro de controles

Merci beaucoup!!!! :D Je vais y arriver ^^!!! Je te met mon code quand j'aurais fini

EDIT :
Code:
Set rg = ActiveSheet.Range("A1")
For Each rg In Range("A2:A" & Range("A65536").End(xlUp).Row)

    If rg.Offset(0, 2).Value <> "" And Len(rg.Offset(0, 2)) = 7 Then
    rg.Offset(0, 2).Interior.ColorIndex = 6
        If rg.Offset(0, 1).Value <> "" And Len(rg.Offset(0, 1)) = 5 Then
        rg.Offset(0, 1).Interior.ColorIndex = 6
       End If
       End If
        If rg.Offset(0, 2).Value <> "" And rg.Offset(0, 1).Value = "" Then
        rg.Offset(0, 2).Interior.ColorIndex = 3
        rg.Offset(0, 1).Interior.ColorIndex = 3
    End If
    If rg.Offset(0, 1).Value <> "" And Len(rg.Offset(0, 1).Value) = 5 Then
    rg.Offset(0, 1).Interior.ColorIndex = 6
  End If
  If rg.Offset(0, 1).Value <> "" And Len(rg.Offset(0, 1).Value) <> 5 Then
  rg.Offset(0, 1).Interior.ColorIndex = 3
  End If
  If rg.Offset(0, 2).Value <> "" And Len(rg.Offset(0, 2)) = 7 Then
    rg.Offset(0, 2).Interior.ColorIndex = 6
    End If
If rg.Offset(0, 2).Value <> "" And Len(rg.Offset(0, 2)) <> 7 Then
    rg.Offset(0, 2).Interior.ColorIndex = 3
    End If
'Possibilité ici de mettre en rouge le CD si le NIC n'est pas renseigné'

    Set rg = rg.Offset(1, 0)
Next rg

Voila cela marche correctement, par contre j'ai l'impression que mon code est vraiment "Beurk" pour pas etre vulgaire (Mais au pire sa c'est pas grave ^^) J'ai meme garder sous le coude certaines modification (Il faut que je vois ce que veux celui pour qui je fais la macro ^^)
Par contre le point suivant est la gestion des doublons, j'ai vu pas mal de code circuler sur le net sur les doublons mais la j'ai un cas spécifique :
Si les numéros de la colonne A, B, C
Ou que A, B
Ou que A
sont renseignés alors il ne doit pas y avoir la meme ligne sur un autre ligne sur une période de date se chevauchant

Et franchement je ne sais pas comment faire.
 
Dernière édition:

nyko283

XLDnaute Occasionnel
Re : Macro de controles

Alors je te propose le code suivant qui evite les doubles vérifications qu'ils y avaient dans ton code, à la fin tu trouve la vérification sur les dates.

VB:
Sub test()
Dim rg As Range, i As Integer


Range("A2:F" & Range("A65536").End(xlUp).Row).Interior.ColorIndex = xlNone ' remise a blanc
For Each rg In Range("A2:A" & Range("A65536").End(xlUp).Row)

    ' Test sur les colonnes B et C selon critere predefini
    If rg.Offset(0, 2).Value <> "" And Len(rg.Offset(0, 2)) = 7 Then ' cas Colonne C OK
        rg.Offset(0, 2).Interior.ColorIndex = 6
        If rg.Offset(0, 1).Value <> "" And Len(rg.Offset(0, 1)) = 5 Then ' cas Colonne B OK
            rg.Offset(0, 1).Interior.ColorIndex = 6
        Else ' Si colonne B vide ou longueur non valide
            rg.Offset(0, 1).Interior.ColorIndex = 3
        End If
        
    ElseIf rg.Offset(0, 2).Value <> "" And Len(rg.Offset(0, 2)) <> 7 Then ' Cas Colonne C nonvide mais pas ok
        rg.Offset(0, 2).Interior.ColorIndex = 3
        If rg.Offset(0, 1).Value <> "" And Len(rg.Offset(0, 1)) = 5 Then ' cas Colonne B OK
            rg.Offset(0, 1).Interior.ColorIndex = 6
        Else ' Si colonne B vide ou longueur non valide
            rg.Offset(0, 1).Interior.ColorIndex = 3
        End If
    ElseIf rg.Offset(0, 2).Value = "" Then ' cas Colonne C vide
        rg.Offset(0, 2).Interior.ColorIndex = xlNone
        If rg.Offset(0, 1).Value <> "" And Len(rg.Offset(0, 1)) = 5 Then ' cas Colonne B OK
            rg.Offset(0, 1).Interior.ColorIndex = 6
        ElseIf rg.Offset(0, 1).Value <> "" And Len(rg.Offset(0, 1)) <> 5 Then ' Si colonne B longueur non valide
            rg.Offset(0, 1).Interior.ColorIndex = 3
        ElseIf rg.Offset(0, 1).Value = "" Then ' Si colonne B vide
            rg.Offset(0, 1).Interior.ColorIndex = xlNone
        End If
    End If
    
    'Test sur les dates pour abscence de chevauchement
    For i = 1 To (Range("A65536").End(xlUp).Row - rg.Row) Step 1
        'Test sur concordance des lignes
       If rg.Value & rg.Offset(0, 1).Value & rg.Offset(0, 2).Value = rg.Offset(i, 0).Value & rg.Offset(i, 1).Value & rg.Offset(i, 2).Value Then
        ' Test sur les dates
        If rg.Offset(i, 4) >= rg.Offset(0, 4) And rg.Offset(i, 4) <= rg.Offset(0, 6) Or rg.Offset(i, 5) >= rg.Offset(0, 4) And rg.Offset(i, 5) <= rg.Offset(0, 5) Then
                rg.Offset(i, 0).Interior.ColorIndex = 39 ' met une couleur lavande
        End If
       End If
    Next i
Next rg
 

Save92

XLDnaute Nouveau
Re : Macro de controles

Bonjour nyko283,
Merci enormement pour ton aide, en combinant les tests avant et ton code j'arrive à la perfection à ce que je devais faire. Un ENORME Merci à toi, tes réponses et de ta patience.
Et puis - je te demander un service :
Code:
'Test sur les dates pour abscence de chevauchement
   For i = 1 To (Range("A65536").End(xlUp).Row - rg.Row) Step 1
        'Test sur concordance des lignes
      If rg.Value & rg.Offset(0, 1).Value & rg.Offset(0, 2).Value = rg.Offset(i, 0).Value & rg.Offset(i, 1).Value & rg.Offset(i, 2).Value Then
        ' Test sur les dates
       If rg.Offset(i, 4) >= rg.Offset(0, 4) And rg.Offset(i, 4) <= rg.Offset(0, 6) Or rg.Offset(i, 5) >= rg.Offset(0, 4) And rg.Offset(i, 5) <= rg.Offset(0, 5) Then
                rg.Offset(i, 0).Interior.ColorIndex = 39 ' met une couleur lavande
       End If
       End If
    Next i

Je ne comprend pas trop les tests que tu effectues? En fait tu compares la ligne à toutes les autres en prenant la date comme parametres? (C'est pour m'enrichir et comprendre le code)
Merci beaucoup à toi encore une fois, dommage que tu habites à Tarbes sinon je t'aurais payé un verre :D.
Cordialement Nicolas (C'est aussi mon prénom ;) )
 

nyko283

XLDnaute Occasionnel
Re : Macro de controles

Bonjour Nicolas,

alors décotiquons ce bout de code :
VB:
For i = 1 To (Range("A65536").End(xlUp).Row - rg.Row) Step 1
on boucle sur les lignes 1 jusqu'a la derniere ligne non vide - la ligne de la cellule de références, donc dans la suite du code avec le offset, on bouclera à partir de la ligne en dessous de la ligne rg jusqu'a la derniere ligne non vide, ceci afin d'eviter de comparer une nouvelle fois sur les meme cellules, car si on compare la ligne 1 avec la ligne 10, le resultat sera le meme si on compare la ligne 10 avec la ligne 1.
VB:
      If rg.Value & rg.Offset(0, 1).Value & rg.Offset(0, 2).Value = rg.Offset(i, 0).Value & rg.Offset(i, 1).Value & rg.Offset(i, 2).Value Then

ici je transforme en chaine de caractere et met bout a bout le contenu des colonnes A B et C de la ligne de référence (rg) que je compare avec la chaine de caractere des colonnes A B et C de la ligne rg.Offset(i, 4), si elle sont identiques (meme numero ou cellule vide sur chaque ligne) alors on rentre dans la conditions
VB:
       If rg.Offset(i, 4) >= rg.Offset(0, 4) And rg.Offset(i, 4) <= rg.Offset(0, 6) Or rg.Offset(i, 5) >= rg.Offset(0, 4) And rg.Offset(i, 5) <= rg.Offset(0, 5) Then

ici on compare les dates
la premiere partie avant le "OR" regarde si la date de debut de la ligne rg.Offset(i, 4) est superieur ou egale a la date de debut de la ligne rg et si la date de depart de la ligne rg.Offset(i, 4) est inférieur à la date de fin de la ligne rg ( ce qui voudrais dire que la ligne rg.Offset(i, 4) commence apres le debut et avant la fin de la ligne rg)
la deuxieme partie fait la meme chose mais avec la date de fin donc que la ligne rg.Offset(i, 4) fini apres le debut de la ligne rg et avant la fin.

une fois combiner les 2 parties on obtient si la ligne rg.Offset(i, 4) commence apres le debut et avant la fin de la ligne rg ou si fini apres le debut de la ligne rg et avant la fin de la ligne rg alors :
VB:
                rg.Offset(i, 0).Interior.ColorIndex = 39 ' met une couleur lavande
       End If
       End If
    Next i

en esperant t avoir fait comprendre mon cheminement et raisonement tout au long de l'élaboration de ce code.

au plaisir au détour d'un bout de code.
 

Discussions similaires

Réponses
2
Affichages
131
Réponses
5
Affichages
195

Statistiques des forums

Discussions
312 312
Messages
2 087 156
Membres
103 484
dernier inscrit
maintenance alkern