1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
| 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 D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Set OS = Worksheets("absences") 'définit l'onglet source OS
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set OD = Worksheets("Résultat") 'définit l'onglet OD (génère une erreur si cet onglet n'existe pas)
If Err > 0 Then 'condition : si une erreur a été générée
Err.Clear 'supprime l'erreur
OS.Copy after:=Sheets(Sheets.Count) 'copie l'onglet OS en dernière position
Set OD = ActiveSheet 'définit l'onglet OD
OD.Name = "Résultat" 'renome l'onglet OD
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
OD.Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données dans l'onglet OD
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 TV (en partant de la seconde)
D(TV(I, 1)) = "" 'alimente le dictionnaire D avec les données en colonne 1 de TV
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 J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments J du tableau temporaire TMP
K = K + 1 'incrémente K
ReDim Preserve TL(1 To UBound(TV, 2), 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
TL(1, K) = TMP(J) 'définit la valeur de la donnée ligne 1 colonne K de TL
For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeur TV (en partant de la seconde)
If TV(I, 1) = TMP(J) Then 'condition : si la donnée Ligne I colonne 1 de TV est égale à l'élément J de TMP
TL(2, K) = TV(I, 2) 'récupère la valeur de la donnée ligne I colonne 2 de TV dans la ligne 2 colonne K de TL (=> Transposition)
TL(3, K) = TV(I, 3) 'récupère la valeur de la donnée ligne I colonne 3 de TV dans la ligne 3 colonne K de TL (=> Transposition)
TL(4, K) = IIf(TL(4, K) = "", TV(I, 4), TL(4, K)) 'si TL(4,K) est vide récupère la valeur de la donnée ligne I colonne 4 de TV sinon garde la valeur existante de TL(4,K) (=> Transposition)
TL(5, K) = TV(I, 5) 'récupère la valeur de la donnée ligne I colonne 5 de TV dans la ligne 5 colonne K de TL (=> Transposition)
TL(6, K) = TV(I, 6) 'récupère la valeur de la donnée ligne I colonne 6 de TV dans la ligne 6 colonne K de TL (=> Transposition)
TL(7, K) = TV(I, 7) 'récupère la valeur de la donnée ligne I colonne 7 de TV dans la ligne 7 colonne K de TL (=> Transposition)
TL(8, K) = TL(8, K) + TV(I, 8) 'calcule la somme de la valeurs des la données en colonne 8 de TV dans la ligne 8 colonne K de TL (=> Transposition)
End If 'fin de la condition
Next I 'prochaine ligne de la boucle 2
Next J 'prochain élément de la boucle 1
OD.Range("A2").Resize(K, UBound(TV, 2)).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé dans la cellule A2 de l'onglet OD
DL = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet OD
OD.Rows(DL + 1 & ":" & Application.Rows.Count).Delete 'supprime les lignes de DL+1 à la dernière
OD.Activate 'active l'onglet OD
End Sub |
