XL 2016 Date prolongée

gbnc68

XLDnaute Nouveau
Bonsoir,
Cela fait pas mal de temps que je cherche une solution EXCEL et/ou POWER QUERY (débutante) pour avoir les dates de début et de fin de contrats lorsqu'elles sont continues.
Un employé peut avoir plusieurs arrêts de travail. Si les dates se suivent, j'aimerai avoir une seule ligne.
J'ai vu que cela était possible sur POWER QUERY mais j'ai un niveau débutant.
Je joins le fichier Excel et le résultat attendu.
Merci et bonne soirée,
G
 

Pièces jointes

  • Date prolongée.xlsx
    13.3 KB · Affichages: 17

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @gbnc68,

J'ai vu que cela était possible sur POWER QUERY mais j'ai un niveau débutant.
Persévérez! Je pense que ça vaut le coup. Quelques membres de ce forum pourront vous aider car trapus en PQ.

En ce qui concerne le VBA, veuillez trouver ci-dessous un code dans le module associé à la feuille nommée "Feuil1" sur son onglet. Cliquer sur le bouton Hop!

Attention fichier vérolé o_O:eek::mad:. Je l'ai retiré pour le réparer.
Fichier réparé => le télécharger ici au message #4
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re, bonjour @sousou ;)
Voici le fichier non vérolé à utiliser

Le code est à utiliser est le code ci-dessous dans le module de la feuille "Feuil1".
VB:
Sub Accoler()
Dim derlig, t, v, k&, i&, ref, deb, fin
   With Sheets("Feuil1")
      If .FilterMode Then .ShowAllData
      derlig = .Cells(.Rows.Count, "a").End(xlUp).Row
      .Range("a2:c" & derlig + 1).Sort key1:=.Range("a2"), order1:=xlAscending, _
         key2:=.Range("b2"), order2:=xlAscending, key3:=.Range("c2"), order3:=xlAscending, _
         Header:=xlYes
      t = .Range("a2:c" & derlig + 1): v = .Range("a2:c" & derlig + 1): k = 1
      ref = t(2, 1): deb = t(2, 2): fin = t(2, 3)
      For i = 3 To UBound(t)
         If t(i, 1) <> ref Or t(i, 2) <> (fin + 1) Then
            k = k + 1
            v(k, 1) = ref: v(k, 2) = deb: v(k, 3) = fin
            ref = t(i, 1): deb = t(i, 2): fin = t(i, 3)
         Else
            fin = t(i, 3)
         End If
      Next i
      Application.ScreenUpdating = False
      .Range("f1:h" & Rows.Count).Clear
      .Range("f2").Resize(k, 3) = v
      .Range("f2").Resize(.Cells(.Rows.Count, "f").End(xlUp).Row - 1, 3).Borders.LineStyle = xlContinuous
      .Range("f2").Resize(, 3).Interior.Color = RGB(200, 200, 200)
      .Range("f2").Resize(, 3).Font.Bold = True
      .Range("f2").Resize(, 3).HorizontalAlignment = xlCenter
      .Range("f2").Resize(, 3).EntireColumn.AutoFit
   End With
End Sub
 

Pièces jointes

  • gbnc68- périodes consécutive- v1.xlsm
    20.4 KB · Affichages: 10
Dernière édition:

gbnc68

XLDnaute Nouveau
Bonjour @gbnc68,


Persévérer! Je pense que ça vaut le coup. Quelques membres de ce forum pourront vous aider car trapus en PQ.

En ce qui concerne le VBA, veuillez trouver ci-dessous un code dans le module associé à la feuille nommée "Feuil1" sur son onglet. Cliquer sur le bouton Hop!

Attention fichier vérolé o_O:eek::mad:. Je l'ai retiré pour le réparer.
Le code doit être OK.


Le code :
VB:
Sub Amaigrir()
Dim derlig, t, v, k&, i&, ref, deb, fin
   With Sheets("Feuil1")
      If .FilterMode Then .ShowAllData
      derlig = .Cells(.Rows.Count, "a").End(xlUp).Row
      .Range("a2:c" & derlig + 1).Sort key1:=.Range("a2"), order1:=xlAscending, _
         key2:=.Range("b2"), order2:=xlAscending, key3:=.Range("c2"), order3:=xlAscending, _
         Header:=xlYes
      t = .Range("a2:c" & derlig + 1): v = .Range("a2:c" & derlig + 1): k = 1
      ref = t(2, 1): deb = t(2, 2): fin = t(2, 3)
      For i = 3 To UBound(t)
         If t(i, 1) <> ref Or t(i, 2) <> (fin + 1) Then
            k = k + 1
            v(k, 1) = ref: v(k, 2) = deb: v(k, 3) = fin
            ref = t(i, 1): deb = t(i, 2): fin = t(i, 3)
         Else
            fin = t(i, 3)
         End If
      Next i
      Application.ScreenUpdating = False
      .Range("f1:h" & Rows.Count).Clear
      .Range("f2").Resize(k, 3) = v
      .Range("f2").Resize(.Cells(.Rows.Count, "f").End(xlUp).Row - 1, 3).Borders.LineStyle = xlContinuous
      .Range("f2").Resize(, 3).Interior.Color = RGB(200, 200, 200)
      .Range("f2").Resize(, 3).Font.Bold = True
      .Range("f2").Resize(, 3).HorizontalAlignment = xlCenter
      .Range("f2").Resize(, 3).EntireColumn.AutoFit
   End With
End Sub
Re,

Voici le fichier à utiliser non vérolé.
Merci.
Je vais étudier cette macro et je vais continuer mes recherches sur power query.
@
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Voici une solution par Power Query. Les différentes étapes sont commentées, laissez traîner votre curseur sur leur nom pour que les commentaires apparaissent.

Ce que fait la requête après récupération des données

1 - tri par Nom et date de début de contrat
2 - indexation des lignes à partir de 0 servira de deuxième Clef de fusion pour décalage de ligne
3 - deuxième indexation des lignes à partir de 1 afin de créer par fusion de la table sur elle-même un décalage de ligne.
4 - compare la date de fin de contrat de la ligne avec le début de contrat de la ligne suivante (obtenu lors de la fusion de la table sur elle-même) et récupère la date de fin si la différence entre les dates est supérieure à 1
5 - Regroupement des lignes sur le nom et la date de fin pour récupérer les date de sorties.


Cordialement
 

Pièces jointes

  • Date prolongée.xlsx
    29.8 KB · Affichages: 12

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Hasco :)
Voici une solution par Power Query.

Alors là chapeau! 🎩🎩🎩🎩
il faut quand même reconnaître qu'il faut un peu de métier et d’expérience avec PQ pour arriver à ce genre de chose.

nb: merci pour les commentaires 👍

Moi qui n'a jamais beaucoup apprécié SQL, j'ai aussi du mal avec PQ dont les requêtes sont dans le même esprit. Il faut que je me soigne et que je me force... parce que Krosoft a décidé pour nous que PQ sera notre futur!
 
Dernière édition:

chris

XLDnaute Barbatruc
Bonjour à tous

Une variante : on ne crée pas de second Index mais on se réfère à la ligne suivante grâce à l'index.
Un peu plus compliqué côté formule mais moins d'étapes. Solution découverte il y a peu sur un forum.

J'ai modifié aussi les étapes d'indexation de la version d'Hasco, car sur la version 2016 de gbnc68 , le 3ème argument ne sera pas accepté.
 

Pièces jointes

  • Date prolongée2.xlsx
    27.5 KB · Affichages: 7

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour à tous,

Hello @mapomme :) , il n'y a que la pratique, le pas à pas et le partage communautaire (sur xld), qui m'ont appris Power Query.
Hello @chris :) (Je l'avais oublié celle-là...arf) c'est la méthode que j'utilisais avant de me rendre compte que sur de grandes tables, elle était plus longue à s'exécuter. Pour ce qui est de l'index, on peut construire une colonne "Index.1" ayant pour valeur = [Index] +1 si le troisième paramètre n'est pas admis dans la version 2016.
// ¨Première indexation des lignes ( à partir de zéro ) qui permettra la récupération de la date de début de contrat de la ligne suivante après fusion de la table sur elle-même. Servira de deuxième clef de fusion
#"Index ajouté" = Table.AddIndexColumn(#"Lignes triées", "Index", 0, 1),
// Deuxième indexation des lignes (à partir de 1) qui servira de première clef de fusion de la table sur elle-même
#"Index 1 ajouté" = Table.AddColumn(#"Index ajouté", "Index.1", each [Index]+1),

Cordialement
 
Dernière édition:

chris

XLDnaute Barbatruc
RE
Toujours pas trouvé de bouquin sur PQ
Celui d'ENI est bien, version papier ou numérique

Il était en promo la semaine dernière, dommage.


Hasco :
Hello @chris :) (Je l'avais oublié celle-là...arf) c'est la méthode que j'utilisais avant de me rendre compte que sur de grandes tables, elle était plus longue à s'exécuter.
Intéressant : je me posais justement la question en la commentant.
Merci de l'info. Je vais garder la précédente solution.
 

Discussions similaires

Réponses
7
Affichages
482
Réponses
14
Affichages
404
Réponses
16
Affichages
1 K

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
315 097
Messages
2 116 186
Membres
112 679
dernier inscrit
Yupanki