Microsoft 365 VBA - EXCEL Compiler plusieurs dates en périodes suivant un code absence

Pb68 · 12 Décembre 2023

Bonjour à tous,

J'ai une nouvelle demande un peu similaire à ma précédente faite début 2023. Je remercie au passage @sylvanu @gbinforme pour leur aide.
J'ai essayé de repartir sur le fichier de ma première demande en le modifiant mais je n'arrive pas au résultat attendu.

J'aimerais que pour chaque matricule, on obtient une date de début et une date de fin par code absence (colonne H) en faisant le cumul de la colonne I.
La macro fonction bien sauf que je n'ai pas plusieurs lignes par code absence lorsqu'il y a une interruption de dates.

Exemple :
Mat 00008 : je souhaite avoir 2 lignes

Mat	Date début	Date fin	Abs Code	Abs Qte
00008	20/07/2023	20/07/2023	300	7
00008	31/07/2023	06/08/2023	300	35

Mais j'ai un cumul des deux lignes :

Mat	Date début	Date fin	Abs Code	Abs Qte
00008	20/07/2023	06/08/2023	300	42

J'ai également essayé d'enlever les colonnes en rouge mais malgré mes tentatives de modification de la macro, elle ne s'exécute plus après. J'ai donc laissé les colonnes en rouge mais je n'en ai pas besoin.

Merci d'avance pour votre aide !

JHA · 12 Décembre 2023

Bonjour à tous,

Un début par formule et power query pour le regroupement.

JHA

Pb68 · 12 Décembre 2023

Bonjour JHA,

Merci pour votre réponse. Je n'ai jamais utilisé power query. J'ai ajouté la fonctionnalité mais je ne sais pas quoi faire avec le fichier. Pouvez-vous m'indiquer la marche à suivre svp ?

Oneida · 12 Décembre 2023

Bonjour,
Votre demande est celle-ci?
Exemple :
Mat 00008 : je souhaite avoir 2 lignes

Mat	Date début	Date fin	Abs Code	Abs Qte
00008	20/07/2023	20/07/2023	300	7
00008	31/07/2023	06/08/2023	300	35

Pb68 · 12 Décembre 2023

Oneida à dit:
Bonjour,
Votre demande est celle-ci?
Exemple :
Mat 00008 : je souhaite avoir 2 lignes

Mat Date début Date fin Abs Code Abs Qte
00008 20/07/2023 20/07/2023 300 7
00008 31/07/2023 06/08/2023 300 35

Bonjour,

Oui c'est bien ça. J'aimerais cette affichage dans l'onglet synthèse.

mapomme · 12 Décembre 2023

Bonsoir à tous ,

Via une macro. Cliquer sur le bouton Hop!

nota : le tableau "extraction" n'a pas besoin d'être trié - la macro s'en charge.

Le code de la macro :

VB:

Sub GrouperPeriode()
Dim xrg As Range, t0, t, der&, i&, i0
Dim som, ref, j&, n&, datfin As Date, deb
 
   Application.ScreenUpdating = False: deb = Timer
   With Sheets("Extraction")
      If .FilterMode Then .ShowAllData
      Set xrg = Intersect(.Range("a1").CurrentRegion, .Columns("a:i"))
      t0 = xrg.Value
      xrg.Sort key1:=.Range("a1"), order1:=xlAscending, key2:=.Range("g1"), order2:=xlAscending, _
      key3:=.Range("h1"), order3:=xlAscending, MatchCase:=False, Header:=xlYes
      t = xrg.Resize(xrg.Rows.Count + 1, xrg.Columns.Count).Value
      xrg.Value = t0: Erase t0
   End With

   t(1, 1) = "Matricule": t(1, 2) = "Code abs": t(1, 3) = "Date debut": t(1, 4) = "Date fin": t(1, 5) = "Qté abs"
   For i = 2 To UBound(t): t(i, 2) = t(i, 8): t(i, 3) = t(i, 7): t(i, 4) = t(i, 7): t(i, 5) = t(i, 9): Next
   ReDim Preserve t(1 To UBound(t), 1 To 5)
   n = 1: i0 = 2
   For i = 3 To UBound(t)
      If t(i, 1) <> t(i0, 1) Or t(i, 2) <> t(i0, 2) Or t(i, 3) <> t(i - 1, 3) + 1 Then
         n = n + 1
         For j = 1 To 5: t(n, j) = t(i0, j): Next
         i0 = i
      Else
         t(i0, 4) = t(i, 4): t(i0, 5) = t(i0, 5) + t(i, 5)
      End If
   Next i
 
  With Worksheets("synthèse")
      .Range("a1").CurrentRegion.Clear
      .Range("a1").Resize(n, 5) = t
      .Range("e1").Resize(n).NumberFormat = "0.00"
      Application.Goto .Range("a1"), True
   End With
   MsgBox Format(Timer - deb, "0.00\ sec.")
End Sub

Pb68 · 12 Décembre 2023

mapomme à dit:

Bonsoir à tous ,

Via une macro. Cliquer sur le bouton Hop!

nota : le tableau "extraction" n'a pas besoin d'être trié - la macro s'en charge.

Le code de la macro :

VB:

Sub GrouperPeriode()
Dim xrg As Range, t0, t, der&, i&, i0
Dim som, ref, j&, n&, datfin As Date, deb
 
   Application.ScreenUpdating = False: deb = Timer
   With Sheets("Extraction")
      If .FilterMode Then .ShowAllData
      Set xrg = Intersect(.Range("a1").CurrentRegion, .Columns("a:i"))
      t0 = xrg.Value
      xrg.Sort key1:=.Range("a1"), order1:=xlAscending, key2:=.Range("g1"), order2:=xlAscending, _
      key3:=.Range("h1"), order3:=xlAscending, MatchCase:=False, Header:=xlYes
      t = xrg.Resize(xrg.Rows.Count + 1, xrg.Columns.Count).Value
      xrg.Value = t0: Erase t0
   End With

   t(1, 1) = "Matricule": t(1, 2) = "Code abs": t(1, 3) = "Date debut": t(1, 4) = "Date fin": t(1, 5) = "Qté abs"
   For i = 2 To UBound(t): t(i, 2) = t(i, 8): t(i, 3) = t(i, 7): t(i, 4) = t(i, 7): t(i, 5) = t(i, 9): Next
   ReDim Preserve t(1 To UBound(t), 1 To 5)
   n = 1: i0 = 2
   For i = 3 To UBound(t)
      If t(i, 1) <> t(i0, 1) Or t(i, 2) <> t(i0, 2) Or t(i, 3) <> t(i - 1, 3) + 1 Then
         n = n + 1
         For j = 1 To 5: t(n, j) = t(i0, j): Next
         i0 = i
      Else
         t(i0, 4) = t(i, 4): t(i0, 5) = t(i0, 5) + t(i, 5)
      End If
   Next i
 
  With Worksheets("synthèse")
      .Range("a1").CurrentRegion.Clear
      .Range("a1").Resize(n, 5) = t
      .Range("e1").Resize(n).NumberFormat = "0.00"
      Application.Goto .Range("a1"), True
   End With
   MsgBox Format(Timer - deb, "0.00\ sec.")
End Sub

Bonjour Mapomme,

Un grand merci à vous !
C'est exactement ce qu'il me fallait.

Je vous souhaite une excellente journée et de belles fêtes de fin d'année.

Merci également aux autres intervenants.

Microsoft 365 VBA - EXCEL Compiler plusieurs dates en périodes suivant un code absence

Pb68

XLDnaute Nouveau

Pièces jointes

JHA

XLDnaute Barbatruc

Pièces jointes

Pb68

XLDnaute Nouveau

Oneida

XLDnaute Impliqué

Pb68

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

Pièces jointes

Pb68

XLDnaute Nouveau

Discussions similaires