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