Discussion :

[lulu92]

Bonjour,

Je sui novice sur le site et je suis bloqué depuis plusieurs mois sur un tableau qui recense les arrêts de travail par matricule et par durée.
Le problème est que pour un même matricule, je peux avoir plusieurs arrêts qui se suivent au niveau des dates sur des lignes différentes. Au final ces différentes lignes ne représentent qu'un seul arrêt.
je cherche donc un moyen de regrouper ces lignes par macro (dates qui se suivent pour un même matricule) afin de n'avoir qu'une seule ligne.

Exemple ligne 3 à 5 pour le matricule 1683. Je cherche à obtenir sur une seul ligne date de début 14/09/2020 et date de fin 18/10/2020.

je vous joins le fichier.

merci pour votre aide, en espérant avoir été clair.

lulu92

[mfoxy]

Bonjour Lulu,

Postez plutôt une copie d'écran de votre tableau ainsi que votre code actuel entre balises #.
Tres peu de membre ouvrent les pièces jointe, qui plus est au premier post

Vous trouverez ainsi de l'aide plus rapidement,
Bav,

[Alex020181]

Bonjour,

On peut bien sûr faire cela en macro VBA mais aussi en formules (voir PJ).

Il te suffit de classer les données par matricules puis date de début et enfin d'appliquer les formules jointes.

Est-ce suffisant ou veux-tu vraiment du code VBA ?

[Malick]

Salut,

Comme vous utilisez Excel 2016, vous avez Power Query en natif.

Voici une proposition via Power Query en passant par un regroupement. Si vous ajouter des données, il vous suffit juste de faire un Clic droit et choisir Actualiser.

[78chris]

Bonjour à tous

Une autre proposition PowerQuery (intégré à Excel à partir de 2016, en add on à partir de 2010)
qui tient compte des absences consécutives pour une même nature d'heures

A noter que le format xls est périmé depuis 13 ans et n'accepte donc aucune des possibilités postérieures à la version 2003

[Alex020181]

J'ai ajouté le cumul des jours.
Sinon tu as les solutions PQ ou VBA.

[lulu92]

Bonjour,

je vous remercie pour vos différentes solutions.
j'ai choisi d'utiliser Power Query qui répond très bien à ce que je souhaite obtenir.

merci

Lulu92

[Thautheme]

Bonjour le fil, bonjour le forum,

J'arrive après la bagarre !... Si ça intéresse quelqu'un, une proposition VBA avec le code ci-dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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