Macro analyse d'un tableau avec plusieurs conditions + récap des erreurs

Sandrine123

XLDnaute Nouveau
Bonjour,

Je sollicite votre aide pour la réalisation d'une macro.

Le fichier en question s'appelle Fichier-test.xls

J'aimerais que la macro vérifie s'il manque des données à l'intérieur.

Voici la liste des contrôles à réaliser (un peu tordu je vous l'accorde :eek: )

1. Les colonnes suivantes ne doivent pas être vide : 1,3,5,6,7,8,9,10,11,12,13,14,17,18,21,22,23,24,25,26,27,35,36

2. Pour les colonnes 2 et 4 : s'il y a une valeur dans la colonne 2, il doit y avoir une valeur dans la colonne 4 et inversement. Si la colonne 2 est vide, la 4 doit être vide. En gros, c'est soit les 2 sont vides soit les 2 ont une valeur.

3. En colonne (AA) : titre 27 c'est des numéros de dossiers.
Pour un même numéro de dossier, les colonnes 6 à 12 ainsi que la 35 doivent être identiques.

4. Si la colonne 2 est renseignée, la colonne 15 doit avoir une valeur.

5. Si la colonne 31 est égale à "ENCOURS", la colonne 24 doit également avoir la valeur "ENCOURS".

6. Si la colonne 19 est renseignée, les colonnes 24 et 31 doivent être vide.


J'aimerais si c'est possible avoir une sorte de rapport final avec les erreurs d'affichées. Soit un onglet supplémentaire qui se créé ou un fichier texte qui s'ouvre.

Par exemple, la liste des cellules vides pour le point 1 et 2.
Les numéros de dossier de la colonne 27 qui posent problème. par exemple (valeurs non identiques dans les colonnes 6 à 12 et 35 pour le dossier T.2014.508)

Merci d'avance de votre aide.

Bonne journée à tous.
 

Pièces jointes

  • Fichier-test.xls
    42.5 KB · Affichages: 29
  • Fichier-test.xls
    42.5 KB · Affichages: 37
  • Fichier-test.xls
    42.5 KB · Affichages: 37
Dernière édition:

Robert

XLDnaute Barbatruc
Repose en paix
Re : Macro analyse d'un tableau avec plusieurs conditions + récap des erreurs

Bonsoir Sandrine, bonsoir le forum,

À tester le code ci-dessous :
Code:
Option Explicit

Sub Macro1()
Dim T As Object 'déclare la variable T (onglet TEST)
Dim RE As Object 'déclare la variable RE (onglet Rapport d'Erreur)
Dim COL As Byte 'déclare la variable COL (COLonne)
Dim DEST As Range 'déclare la variable Dest (cellule de DESTination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire))
Dim I As Integer 'déclare la variable I (Inrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'déclare la variable PA (Première Adresse)
Dim TBI(2) As Variant 'déclare le tableau de variables TBI (TaBleau Initial))
Dim TBC(2) As Variant 'déclare le tableau de variables TBC (TaBleau de Comparaison)
Dim CL As Byte 'déclare la variable CL (CoLonne)

Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Set T = Sheets("TEST") 'définit l'onglet T
Set RE = Sheets("Rapport") 'définit l'onglet RE
'si la cellule A2 de l'onglet R n'est pas vide, efface les anciennes données
If RE.Range("A2").Value <> "" Then RE.Range("A1").CurrentRegion.Offset(1, 0).ClearContents

'*****************************************************
'code correspondant à ta requête Nº 1 : Code Erreur 01
'*****************************************************
For COL = 1 To 36 'boucle sur le colonne 1 à 36
    Select Case COL 'agit en fonction de la colonne
        'cas pour les colonnes 1, ..., 36
        Case 1, 3, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 17, 18, 21, 22, 23, 24, 25, 26, 27, 35, 36
            'condition : si le nombre de valeurs dans la colonne =1 (le titre)
            If Application.WorksheetFunction.CountA(T.Columns(COL)) = 1 Then
                'définit la cellule de destination DEST
                Set DEST = RE.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
                'renvoie dans DEST l éxplication de l'erreur
                DEST.Value = "La Colonne " & COL & " (= " & Split(Mid(T.Cells(1, COL).Address, 2), "$")(0) & ") est vide ! Code Erreur : 01"
            End If 'fin de la condition
    End Select 'fin de l'action en fonction de ...
Next COL 'prochaine colonne de la boucle
'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet T
DL = T.Cells(Application.Rows.Count, 1).End(xlUp).Row
Set PL = T.Range("A2:A" & DL) 'définit la plage PL
For Each CEL In PL 'boucle sur toutes les cellules de la plage PL

    '************************************
    'code correspondant à ta requête Nº 2
    '************************************
    If CEL.Offset(0, 1).Value = "" And CEL.Offset(0, 3).Value <> "" Then
        Set DEST = RE.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
        DEST.Value = "Ligne : " & CEL.Row & ", les colonnes 2 (= B) et 4 (=D) sont différentes ! Code Erreur : 02"
    ElseIf CEL.Offset(0, 1).Value <> "" And CEL.Offset(0, 3).Value = "" Then
        Set DEST = RE.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
        DEST.Value = "Ligne : " & CEL.Row & ", les colonnes 2 (= B) et 4 (=D) sont différentes ! Code Erreur : 02"
    End If
    
    '************************************
    'code correspondant à ta requête Nº 4
    '************************************
    If CEL.Offset(0, 1).Value <> "" And CEL.Offset(0, 14) = "" Then
        Set DEST = RE.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
        DEST.Value = "En Ligne : " & CEL.Row & ", la colonne 2 (= B) contient une valeur mais la colonne 15 (= O) n'est pas renseignée ! Code Erreur : 04"
    End If
    
    '************************************
    'code correspondant à ta requête Nº 5
    '************************************
    If CEL.Offset(0, 30).Value = "EN COURS" And CEL.Offset(0, 23).Value <> "EN COURS" Then
        Set DEST = RE.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
        DEST.Value = "En Ligne : " & CEL.Row & ", Problème [EN COURS] colonnes 31 (= AE) et 24 (= X) ! Code Erreur : 05"
    End If
    
    '************************************
    'code correspondant à ta requête Nº 6
    '************************************
    If CEL.Offset(0, 18).Value <> "" And Application.WorksheetFunction.CountA(CEL.Offset(0, 23), CEL.Offset(0, 30)) <> 0 Then
        Set DEST = RE.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
        DEST.Value = "En Ligne : " & CEL.Row & ", la ou les colonnes 24 (= X) et 31 (= AE) contiennent des données alors que la colonne 19 (= S) est renseignée ! Code Erreur : 06"
    End If

Next CEL 'prochaine cellule de la boucle
    
'************************************
'code correspondant à ta requête Nº 3
'************************************
Set PL = PL.Offset(0, 26) 'redéfinit la plage PL (colonne AA)
Set D = CreateObject("Scripting.Dictionary") 'définit la dictionnaire D
For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL
    D(CEL.Value) = "" 'alimente le dictionnaire D
Next CEL 'prochaine cellule de la boucle
TMP = D.keys 'récupère dans la tabelau temporaire TMP la liste des dossiers sans doublons
Set PL = PL.Offset(-1, -26).Resize(PL.Rows.Count + 1) 'redéfinit la plage PL (ajoute la lignbe du titre)
For I = 0 To UBound(TMP) 'boucle 1 : sur tous les dossiers
    'définit la recherche R (recherche le numéro de dossier dans la colonne 27 (=AA)
    Set R = T.Columns(27).Find(TMP(I), , xlValues, xlWhole)
    If Not R Is Nothing Then 'condition 1 : si il existe au moins une occurrence
        PA = R.Address 'définit l'adresse PA de la première occurrence trouvée
        TBI(0) = T.Cells(R.Row, 6).Value 'renseigne le tableau TBI par la valeur de la cellule en colonne 6
        TBI(1) = T.Cells(R.Row, 12).Value 'renseigne le tableau TBI par la valeur de la cellule en colonne 12
        TBI(2) = T.Cells(R.Row, 35).Value 'renseigne le tableau TBI par la valeur de la cellule en colonne 35
        Do 'exécite
            Set R = T.Columns(27).FindNext(R) 'redéfinit la recherche R (occurrence suivante)
            TBC(0) = T.Cells(R.Row, 6).Value 'renseigne le tableau TBI par la valeur de la cellule en colonne 6
            TBC(1) = T.Cells(R.Row, 12).Value 'renseigne le tableau TBI par la valeur de la cellule en colonne 12
            TBC(2) = T.Cells(R.Row, 35).Value 'renseigne le tableau TBI par la valeur de la cellule en colonne 35
            For J = 0 To 2 'boucle 2 : sur les 3 données
                Select Case J 'agit en fonction de l'élément de la boucle
                    Case 0 'cas 0
                        CL = 6 'définit la colonne CL
                    Case 1 'cas 1
                        CL = 12 'définit la colonne CL
                    Case 2 'cas 2
                        CL = 35 'définit la colonne CL
                End Select 'fin de l'action en fonction de...
                If TBI(J) <> TBC(J) Then 'condition 2: si les deux élément sont différents
                    'définit la cellule de destination DEST
                    Set DEST = RE.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
                    'renvoie dans DEST l éxplication de l'erreur
                    DEST.Value = "En Ligne : " & R.Row & ", Colonne : " & CL & ", problème avec le dossier : " & R.Value & " ! Code Erreur : 03"
                End If 'fin de la condition 2
            Next J 'prochaine donnée de la boucle 2
        'boucle tant qu'il existe de nouvelles occurrence ailleurs qu'en PA
        Loop While Not R Is Nothing And R.Address <> PA
    End If 'fin de la condition 1
Next I 'prochain dossier de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissement d'écran
End Sub

Ton Fichier modifié :
 

Pièces jointes

  • Sandrine_v01.xls
    74 KB · Affichages: 30

Sandrine123

XLDnaute Nouveau
Re : Macro analyse d'un tableau avec plusieurs conditions + récap des erreurs

Bonjour Robert,

Merci beaucoup pour votre aide.

J'avais juste une petite précision à vous demander :

- Pour les colonnes qui ne doivent pas être vides (1, 3, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 17, 18, 21, 22, 23, 24, 25, 26, 27, 35, 36) la macro ne liste pas les lignes à problème. C'est à dire, si je supprime un chiffre en A5 par exemple, l'erreur n'est pas répertoriée dans l'onglet "Rapport".

Comment résoudre ce problème ? :)

Merci d'avance.
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Macro analyse d'un tableau avec plusieurs conditions + récap des erreurs

Bonjour Sandrine, bonjour le forum,

Oui tu as raison c'est parce que j'avais mal compris ta requête. Je pensais que tu voulais un message d'erreur si la colonne entière était vide et non pas si la cellule de la colonne était vide...
Voici la version 2 modifiée :
 

Pièces jointes

  • Sandrine_v02.xls
    66 KB · Affichages: 25

Discussions similaires

Réponses
11
Affichages
473

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T