Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim L As String 'déclare la variable L (Liste)
Dim IND As Byte 'déclare la variable IND (INDex)
Dim ETAT As String 'déclare la variable ETAT
Dim CD As Variant 'déclare la variable CD (Choix Début)
Dim CP As Variant 'déclare la variable CP (Choix Période)
Dim DDB As Date 'déclare la variable DDB (Date DéBut)
Dim DFI As Date 'déclare la variable DFI (Date FIn)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim DA As Date 'déclare la variable DA (DAte)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Set OS = Worksheets("Feuil1") 'définit l'onglet source OS
Set OD = Worksheets("Feuil3") 'définit l'onglet destination OD
OD.Cells.ClearContents 'efface le contenu de l'onglet destination
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
D(TV(I, 12)) = "" 'alimente le dictionnaire D avec les données en colonne 12 de TV (le statut)
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
For I = 0 To UBound(TMP) 'boucle sur tous les éléments du tableau temporaire D
'définit la liste L des éléments du tableau temporaire TMP
L = IIf(L = "", I + 1 & "-" & TMP(I), L & ", " & I + 1 & "-" & TMP(I))
Next I 'prochain élément de la boucle
ici: 'étiquette
'boite d'entrée pour définir l'index IND de l'état
IND = Application.InputBox("Choisissez l'état que vous voulez extraire en fonction de sa position de 1 à " & D.Count & " : " & Chr(13) & L, "ETAT", Type:=1)
If IND = False Then Exit Sub 'si bouton [Annuler], sort de la procédure
'si l'index IND est inférieur à 1 ou supérieur au nombre d'élément du dictionnaire D, message, va à l'étiquette "ici"
If IND < 1 Or IND > D.Count Then MsgBox "la valeur doit être comprise entre 1 et " & D.Count & " !": GoTo ici
ETAT = TMP(IND - 1) 'définit l'ETAT choisi
la: 'étiquette
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
'boîte d'entrée pour définir le choix du début CB (en cliquant sur une cellule de la colonne N)
Set CD = Application.InputBox("Cliquez sur la cellule qui représente la date du début du mois !", "DATE DU DÉBUT", Type:=8)
If Err <> 0 Then 'condition : si une erreur a été générée (bouton [Annuler] ou autre)
Err.Clear 'supprime l'erreur
Exit Sub 'sort de la procédure
End If 'fin de la condition
'condition : si la cellulle sélectionnée ne fait pas partie des dates de la colonne N
If Application.Intersect(CD, Application.Intersect(OS.Columns(14), OS.UsedRange)) Is Nothing Then
MsgBox "Veuillez cliquer sur une date de la colonne N " & Chr(34) & "Début Projet" & Chr(34) & " !" 'message
GoTo la 'va à l'étiquette "la"
End If 'fin de la condition
DDB = DateSerial(Year(CD), Month(CD), 1) 'définit la date de début DDB
'boîte d'entrée pour définir le choix dde la période CP
CP = Application.InputBox("Veuillez indiquer la période de l'extraction en nombre de mois.", "PÉRIODE", Type:=1)
If CP = False Then Exit Sub 'si bouton [Annuler], sort de la procédure
DFI = DateSerial(Year(DDB), Month(DDB) + CP + 1, 0) 'définit la date de fin DFI
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
If TV(I, 12) = ETAT Then 'condition 1 : si le statut en colonne 12 est égale à l'ETAT
DA = DateSerial(Year(TV(I, 14)), Month(TV(I, 14)), 1) 'définit la date DA en colonne 14 de la ligne de la boucle
If DA >= DDB And DA <= DFI Then 'condition 2 : si la date DA est comprise entre la date de début DDB et la date de fin DFI
'redimensione le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
ReDim Preserve TL(1 To UBound(TV, 2), 1 To K)
For J = 1 To UBound(TV, 2) 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV
TL(J, K) = TV(I, J) 'récupère dans la ligne J de TL la donnée en colonne J de TV (=> Transposition)
Next J 'prochaine colonne de la boucle 2
K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes)
End If 'fin de la condition 2
End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle
If K > 1 Then 'condition : si K est supérieur à 1
'renvoie les paramètres de l'extraction dans la ligne 1
OD.Range("A1").Value = "État :": OD.Range("B1").Value = ETAT: OD.Range("C1").Value = "Mois début :": OD.Range("D1").Value = DDB
OD.Range("E1").Value = "Période :": OD.Range("F1") = CP & " mois"
OD.Range("A1, C1, E1").HorizontalAlignment = xlRight 'alignement à droite des celllules A1, C1 et E1
'renvoie la première ligne du tableau des valeurs dans A3 redimensionnée
OD.Range("A3").Resize(1, UBound(TV, 2)).Value = Application.Index(TV, 1)
'renvoie le tableau Tl transposé dans A4 redimensionnée
OD.Range("A4").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
OD.Activate 'active l'onglet OD
Else 'sinon
MsgBox "Aucune donnée à extraire avec ces paramètres !" 'message
End If 'fin de la condition
End Sub
