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
 

Save92

XLDnaute Nouveau
Re : Macro de controles

Ta maccro fonctionne très bien mais juste une chose serait il possible de mettre la premiere ligne en doublon aussi? Car c'est peut être cette ligne qui faut changer?
123456789|12345 |
123456789|12345 |9876543
123456789|12345 |1234567

Par exemple ici mettre les trois lignes en doublons?
 

Save92

XLDnaute Nouveau
Re : Macro de controles

Et peux tu m'expliquer dans ton code comment fais tu pour verrifier la colonne C?
Car je ne vois pas de test? Merci
Franchement j'etais partie sur des boucle et je commencais à me perdre en voyant mon code et le tiens je pense que je ne suis pas parti dans la bonne direction, le probleme c'est que j'ai du mal à comprendre tous tes test :D

Mon code qui n'est pas complet et qui ne fonctionne pas dans tous les cas
:
Code:
  '-------------- Test doublons -------------
  
For i = 2 To (Range("A65536").End(xlUp).Row - rg.Row) Step 1
    VarA = Cells(i, 1).Value
    VarB = Cells(i, 2).Value
    VarC = Cells(i, 3).Value
    VarDateD = Cells(i, 5).Value
    VarDateF = Cells(i, 6).Value
    j = i + 1
    k = j

    If VarA <> "" And VarA = Cells(j, 1).Value Then
        Do While VarA = Cells(j, 1).Value
            If VarB <> "" And VarB = Cells(j, 2).Value Then
                Do While VarA = Cells(k, 1).Value And VarB = Cells(k, 2).Value
                    If VarC = "" And Cells(k, 3).Value <> "" Then
                        Cells(j, 1).Interior.Pattern = xlLightHorizontal ' met un motif dans la cellule
                        Cells(j, 1).Interior.PatternColorIndex = 39 ' met une couleur lavande
                        Cells(i, 1).Interior.Pattern = xlLightHorizontal ' met un motif dans la cellule
                        Cells(i, 1).Interior.PatternColorIndex = 39 ' met une couleur lavande
                    ElseIf VarC <> "" And VarC = Cells(j, 3).Value Then
                        If Cells(j, 5).Value > VarDateD And Cells(j, 5).Value < VarDateF Or _
                            Cells(j, 6).Value > VarDateD And Cells(j, 6).Value < VarDateF Then
                            Cells(j, 1).Interior.Pattern = xlLightHorizontal ' met un motif dans la cellule
                            Cells(j, 1).Interior.PatternColorIndex = 39 ' met une couleur lavande
                            Cells(i, 1).Interior.Pattern = xlLightHorizontal ' met un motif dans la cellule
                            Cells(i, 1).Interior.PatternColorIndex = 39 ' met une couleur lavande
                        End If
                        End If
                        k = k + 1
                Loop
            ElseIf VarB = "" And Cells(j, 2).Value <> "" Then
                Cells(j, 1).Interior.Pattern = xlLightHorizontal ' met un motif dans la cellule
                Cells(j, 1).Interior.PatternColorIndex = 39 ' met une couleur lavande
                Cells(i, 1).Interior.Pattern = xlLightHorizontal ' met un motif dans la cellule
                Cells(i, 1).Interior.PatternColorIndex = 39 ' met une couleur lavande
            ElseIf VarB = Cells(j, 2) And VarC = Cells(j, 3) Then
            If Cells(j, 5).Value > VarDateD And Cells(j, 5).Value < VarDateF Or _
                            Cells(j, 6).Value > VarDateD And Cells(j, 6).Value < VarDateF Then
                            Cells(j, 1).Interior.Pattern = xlLightHorizontal ' met un motif dans la cellule
                            Cells(j, 1).Interior.PatternColorIndex = 39 ' met une couleur lavande
                            Cells(i, 1).Interior.Pattern = xlLightHorizontal ' met un motif dans la cellule
                            Cells(i, 1).Interior.PatternColorIndex = 39 ' met une couleur lavande
                        End If
                End If
        j = j + 1
        Loop
    End If
Next i
 

Save92

XLDnaute Nouveau
Re : Macro de controles

Je capitule, j'ai essayer avec mon code, mais il faut trier, mais il y a un probleme de format pour le tri donc j'ai essayer avec ton code pour le tri, sauf que mon ordi plante franchement c'est vraiment une galère et j'en ai besoin je sais pas comment tu fais pour y arriver ^^, je te tire mon chapeau. ;)
 

nyko283

XLDnaute Occasionnel
Re : Macro de controles

Bonjour Nicolas,

J'ai donc intégrer le fait de mettre en évidence la ligne d'oriigine du doublon (je pense que c'est cette ligne qui te faissait penser que le doublon n'était pas détecter).

De plus j'avais (pensant bien faire :eek:) integrer la transformation des nombres en texte dans la boucle principale mais comme appres les test avait lieu entre du texte et des nombres, il ne trouvait plus de doublons, voila qui est donc corriger.

Pour le test de la colonne C
le test est le suivant ( c'est les dernieres ligne de code) :

VB:
ElseIf rg.Offset(0, 1) = rg.Offset(i, 1) Then
                    If rg.Offset(0, 2) = rg.Offset(i, 2) Or (rg.Offset(0, 2) = "" And rg.Offset(i, 2) <> "") Or (rg.Offset(0, 2) <> "" And rg.Offset(i, 2) = "") Then
                        rg.Offset(i, 0).Interior.Pattern = xlLightHorizontal ' met un motif dans la cellule
                        rg.Offset(i, 0).Interior.PatternColorIndex = 39 ' met une couleur lavande
                        rg.Interior.Pattern = xlLightHorizontal ' met un motif dans la cellule
                        rg.Interior.PatternColorIndex = 39 ' met une couleur lavande

                    End If
                End If

dans le fichier joint, j'ai trier les données en fonction du "Si" puis du "N" et enfin du "C" ( une fois la macros exécuté)afin de pouvoir regarder si le code en aurait louper, pour moi rien n'est passer au travers du code ( pour mes yeux, alors regarde avec tes yeux si tu en trouve).
T'inquiète on y est presque:rolleyes:..... J'espère...:p
 

Pièces jointes

  • Table des exeptions.xls
    157 KB · Affichages: 42
  • Table des exeptions.xls
    157 KB · Affichages: 43
  • Table des exeptions.xls
    157 KB · Affichages: 42

Save92

XLDnaute Nouveau
Re : Macro de controles

Voila un fichier ou j'ai pu tester la macro, avec erreurs, et un autre, le complet ou même apres une dizaine de minutes la macro ne fini pas.
 

Pièces jointes

  • Table des exceptions PRIME CGA1 20110928.zip
    94.3 KB · Affichages: 22
  • Table des exceptions PRIME CGA1 20110928.zip
    94.3 KB · Affichages: 23
  • Table des exceptions PRIME CGA1 20110929.zip
    69.2 KB · Affichages: 22
  • Table des exceptions PRIME CGA1 20110928.zip
    94.3 KB · Affichages: 22

nyko283

XLDnaute Occasionnel
Re : Macro de controles

Regarde ce fichier j'ai rajouter 4 ligne de codes

au debut
VB:
Columns("A:C").NumberFormat = "General" ' permet de repasser toutes les cellules format standard
Application.Calculation = xlCalculationManual ' empeche le recalcul du classeur pendant l'execution du code
a la fin
VB:
Application.Calculate
Application.Calculation = xlCalculationAutomatic
qui empeche lors de la modification de cellule le recalcul de toutes les formules soit dans ce fichiers + de 2500 recalculs de toutes les formules.....;) donc j'avais le meme probleme la macro qui mettait 15 minutes:( avant de ce terminer donc maintenant, le code s'execute en 2,3 minutes :)pour les 855 lignes du tableau.
 

Pièces jointes

  • Table des exceptions PRIME CGA1 20110928.zip
    105.9 KB · Affichages: 30
  • Table des exceptions PRIME CGA1 20110928.zip
    105.9 KB · Affichages: 23
  • Table des exceptions PRIME CGA1 20110928.zip
    105.9 KB · Affichages: 24

nyko283

XLDnaute Occasionnel
Re : Macro de controles

Alors en fait on modifie la methode de calcul avant d'appeler le code pour modifier le format "Call Entexte" donc lors de l'exécution de ce code il n'y aura pas de recalcul et permet de réduire considérablement le temps d'execution de la macro car sur les 15 minutes qu'il fallait, 12 était pour la modification de format.

petite ligne de code que tu peut rajouté juste avant "Application.Calculate"
VB:
Range("A1:F" & Range("A65536").End(xlUp).Row).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range _
        ("B2"), Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
        xlTopToBottom, DataOption1:=xlSortTextAsNumbers, DataOption2:= _
        xlSortTextAsNumbers, DataOption3:=xlSortTextAsNumbers
qui va trier les données selon le "Si" puis suivant le "N" et pour finir suivant le "C" ceci avant de repérer plus facilement les doublons d'un meme "Si" .
 

Save92

XLDnaute Nouveau
Re : Macro de controles

Merci beaucoup par contre j'essai d'utiliser
Code:
MonFichier = Application.GetOpenFilename("Fichiers Excel (*.xl*), *.xl*")
If MonFichier <> False Then
Workbooks.Open Filename:=MonFichier
Else
Exit Sub
End If
Pour sélectionner le fichier à traiter mais il me met des erreurs (je pense que c'est du a Option Explicit mais comment le regler? Merci de ton aide
 

nyko283

XLDnaute Occasionnel
Re : Macro de controles

Dans le fichier joint, tout à été modifié pour pouvoir exécuter la macro dans un autre classeur choisi par l'utilisateur.

2 versions sont disponibles :

la premiere comme d'habitude.(module1)

la deuxieme permet l'affichage d'un message invitant à patienter...(module 2 + userform1)
 

Pièces jointes

  • fichier de base.xls
    75.5 KB · Affichages: 36
  • fichier de base.xls
    75.5 KB · Affichages: 40
  • fichier de base.xls
    75.5 KB · Affichages: 36

nyko283

XLDnaute Occasionnel
Re : Macro de controles

Pour repondre à ta question le option explicit pemet de forcer la déclaration de variables permettant ainsi de gagner en mémoire utiliser par excel lors de l'execution du code + d'eradiquer les fautes d'orthographes ( comme comme dans mes messages...)

en fail'erreur provient des Range("....") car si le parent n'est pas spécifier,excel concluera que c'est (il me semble car j'ai pris l'habitude de toujours spécifié les parents) le classeur dans lequel le code est ecrit et la feuille active de ce classeur. Donc en rajoutant devant le nom du classeur et le nom de la feuille que l'on souhaite utiliser, il n'y a plus d'erreur possible d'où le wbkWs.range("....") en ayant au préalable défini wbkWs comme ceci :
set wbkWs = workbook(monFichier).sheets("Table")
"Table" est à modifié selon le nom réel de la feuille
 

Save92

XLDnaute Nouveau
Re : Macro de controles

YES!!!! c'est exactement ça!!!!! Tu es le roi des Nicolas ;)! je savais que les Nicolas vaincrais :p!
Nan serieusement merci beaucoup!!! Si jamais tu passes sur Paris un de ces jours n'hésite pas à me contacter jte pairai un verre avec grand plaisir :D
(J'ai plus qu'à faire encore quelques tests et c'est bon :p)
 

Save92

XLDnaute Nouveau
Re : Macro de controles

Et une petite question, la macro est obligée de supprimer la ligne G,G? parceque j'ai des données textes dedans à garder (pas à traiter), en fait j'ai des données jusqu'à la colonne J, après plus rien, mais de la G à la J il faut que cela reste tel quel.
 
Dernière édition:

Discussions similaires

Réponses
2
Affichages
133
Réponses
5
Affichages
198

Statistiques des forums

Discussions
312 361
Messages
2 087 613
Membres
103 607
dernier inscrit
lolo1970