Synthétiser un tableau

Version imprimable

11/12/2022, 00h49
0spawn

1 pièce(s) jointe(s)

Synthétiser un tableau

Bonjour,

Je suis débutant en VBA et j'arrive à coder grâce à mes recherches sur internet. Il m'arrive de trouver mes réponses sur ce forum mais là je sèche sur le fait d'avoir besoin d'un résumé en automatique du contenu d'un tableau que je veux placer dans un second tableau. J'ai fait une macro avec un bouton pour trier ce 1er tableau et un autre pour effacer le contenu qui sera dans le second.

Il est inscrit dans le 1er tableau les personnes qui ont été arrêtées pour différents motif avec la date de chaque jour concerné. J'aimerai automatiser le fait d'avoir dans le second tableau, un regroupement des lignes qui concernent une même personne pour le même motif d'arrêt avec la date de début (qui correspond à la ligne contenant la date la plus ancienne) et la date de fin (qui correspond à la ligne contenant la plus récente en s'assurant que les dates se suivent) .Bien entendu, une ligne dans le 1er tableau peut être la seule concernée pour un motif particulier et donc avoir une date de début et une date de fin identique.

Je mets à disposition le fichier avec le second tableau contenant le résumé comme il faudrait qu'il soit à l'aide d'une macro.

J'ai mis des valeurs comme exemple pour comprendre la logique et le résultat que j'ai besoin d'avoir.

Merci d'avance pour votre aide

PS: C'est la 1ère fois que je poste, donc n'hésitez pas à m'indiquer si je n'ai pas bien respecté les règles du forum afin que je puisse me corriger pour les prochaines fois ;) .

Pièce jointe 630492

1 pièce(s) jointe(s)

Bonjour

Faisable par PowerQuery, intégéré à Excel, selon ce principe http://www.excel-formations.fr/Trucs_astuces/PQ05.php

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
let
    Source = Excel.CurrentWorkbook(){[Name="Tab_ListeArrets"]}[Content],
    #"Type modifié" = Table.TransformColumnTypes(Source,{{"Matricule", type text}, {"Prénom", type text}, {"Nom", type text}, {"Type", type text}, {"Date", type date}}),
    #"Lignes triées" = Table.Sort(#"Type modifié",{{"Matricule", Order.Ascending}, {"Date", Order.Ascending}, {"Type", Order.Ascending}}),
    #"Index ajouté" = Table.AddIndexColumn(#"Lignes triées", "Index0", 0, 1, Int64.Type),
    #"Index ajouté1" = Table.AddIndexColumn(#"Index ajouté", "Index1", 1, 1, Int64.Type),
    #"Requêtes fusionnées" = Table.NestedJoin(#"Index ajouté1", {"Index1"}, #"Index ajouté1", {"Index0"}, "Index ajouté1", JoinKind.LeftOuter),
    #"Index ajouté1 développé" = Table.ExpandTableColumn(#"Requêtes fusionnées", "Index ajouté1", {"Matricule", "Type", "Date"}, {"Matricule.1", "Type.1", "Date.1"}),
    #"Personnalisée ajoutée" = Table.AddColumn(#"Index ajouté1 développé", "Date fin", each if [Matricule]=[Matricule.1] and [Type]=[Type.1] and Date.AddDays([Date],1)=[Date.1] then null else [Date], type date),
    #"Rempli vers le haut" = Table.FillUp(#"Personnalisée ajoutée",{"Date fin"}),
    #"Personnalisée ajoutée1" = Table.AddColumn(#"Rempli vers le haut", "JO", each if Date.DayOfWeek([Date])+1>5 then 0 else 1),
    #"Lignes groupées" = Table.Group(#"Personnalisée ajoutée1", {"Matricule", "Prénom", "Nom", "Type", "Date fin"}, {{"Date début", each List.Min([Date]), type nullable date}, {"Nb Jours", each List.Sum([JO]), type number}}),
    #"Colonnes permutées" = Table.ReorderColumns(#"Lignes groupées",{"Matricule", "Prénom", "Nom", "Type", "Date début", "Date fin", "Nb Jours"}),
    #"Lignes triées1" = Table.Sort(#"Colonnes permutées",{{"Date début", Order.Ascending}})
in
    #"Lignes triées1"

Ta formule ne tenant pas compte des jours fériés, j'ai fait de même mais on pourrait en tenir compte

11/12/2022, 17h55
0spawn

Citation:

Envoyé par 78chris

Bonjour

Faisable par PowerQuery, intégéré à Excel, selon ce principe http://www.excel-formations.fr/Trucs_astuces/PQ05.php
[...]

Ta formule ne tenant pas compte des jours fériés, j'ai fait de même mais on pourrait en tenir compte

Merci beaucoup 78chris pour ta réponse qui semble être d'être d'une grande efficacité. Cependant, je ne connais pas encore PowerQuery.
J'ai pu consulter le lien que tu as mis dans ton poste. Même si cela correspond exactement à mon problème, j'aimerai savoir s'il serait possible de faire la même chose en code VBA afin que je puisse comprendre la logique de la fonction ?

Je garde précieusement ta solution par PowerQuery pour le jour où je pourrai commencer à me servir de cet outil, mais seulement après avoir eu des notions suffisantes pour l'exploiter.

Peut-être qu'à partir des explications présentent dans ton lien, je pourrai trouver son équivalent en code VBA en continuant mes recherches.

En tout cas, je te remercie pour ta réponse rapide à mon problème.
11/12/2022, 21h39
deedolith

Citation:

Envoyé par 0spawn

j'aimerai savoir s'il serait possible de faire la même chose en code VBA afin que je puisse comprendre la logique de la fonction ?

C'est certainnement fesable via VBA avec plutôt plus que moins d'efforts.

Cependant, avec toutes les fonctionnalités intégrées à Excel, VBA devient de moins en moins utile.
Renseignes-toi sur Power Query, tu n'en tireras que des avantages.
12/12/2022, 06h11
0spawn

Il est certain que pour des habitués de ces fonctionnalités d'Excel, l'utilisation d'un outil plus facile et efficace comme Power Query est logique.

De mon côté j'ai besoin d'avoir la fonction que je recherche avec une macro VBA (langage que je connais un peu à la différence de Power Query où je suis au niveau 0)

Si quelqu'un sait comment faire pour avoir le même résultat en VBA, je suis preneur.

Encore merci pour l'intérêt que vous portez à ma demande.
12/12/2022, 09h12
BENNASR

1 pièce(s) jointe(s)
Bonjour
PowerQuery la solution la plus efficace. Personnellement j'ai été retissant et voir ce nouveau langage (code en rouge et des requêtes pour un autodidacte !!! :(:( )
mais j'ai osé et appliquer les conseils des amis du site et j'ai trouvé que c'est un outil simple et très efficace ..bref
pour ton cas j'ai pensé à une solution plus simple
à ton tableau j'ajoute 4 colonnes
* un pour concaténer le matricule, le nom et le prénom
* un pour mettre 1 (nbre de jour devant chaque date)
* un pour extraire le mois avec la formule (= texte(date;"mmm")
* un pour extraire l'année avec la formule (=annee(date))
puis j'insère un tableau dynamique croisée et des segments et tu aura se que tu veux sans casse de tète
J'espère que ça t'aide à avancer

NB pour effacer un tableau structuré tu peux faire avec :
Code:

1 2 3 4 5 Sub EFFACERRESUME() Dim Tab_SyntheseArrets As ListObject Set t = Worksheets("RESUME ARRETS").ListObjects("Tab_SyntheseArrets") t.DataBodyRange.Clear End Sub
12/12/2022, 22h22
0spawn

N'étant pas l'utilisateur et propriétaire du tableau d'absence, je ne peux pas en modifier le format en ajoutant des colonnes.

Pour le moment je ne peux avoir qu'une solution en VBA qui doit être capable de traiter les données dans ce format de tableau pour en effectuer la synthèse dans le second.

Dans mes recherches, j'ai trouvé ce post : https://www.developpez.net/forums/d1...fonction-date/

Celui-ci parle du même problème que moi à la différence que son tableau source a une colonne pour la date de début et une colonne pour la date de fin. A partir de la solution qui a été trouvé, il faudrait pouvoir l'adapter au fait d'avoir qu'une seule colonne pour le champ date dans le tableau source et qu'en regroupant les lignes qui doivent l'être, avoir une date de début et une date de fin dans le tableau de synthèse.

En tout cas, je vous suis très reconnaissant pour tous les efforts que vous mettez pour me proposer des solutions à mon besoin.

1 pièce(s) jointe(s)

Bonjour
vous insistez sur VBA donc j'ai bricoler ce qui suit
NB : j'ai constater selon ton exemple que vous regrouper par mois donc j'ai ajouter une colonne pour extraire le mois
Cliquer sur le dernier bouton "effacer les données"
J'espère que ça t'aide à avancer

Code:

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
51
52
53
Sub test()
Application.ScreenUpdating = False
Dim F1 As Worksheet
Set F1 = Sheets("RESUME ARRETS")
Application.ScreenUpdating = False
Dim Tab_SyntheseArrets As ListObject
Set t = F1.ListObjects("Tab_SyntheseArrets")
 t.DataBodyRange.Clear
Dim i As Long
Set d = CreateObject("Scripting.Dictionary")
    '**********************************************************
    On Error Resume Next
    TblBD = F1.Range("A5:E" & F1.Range("A" & Rows.Count).End(xlUp).Row)
          For i = 1 To UBound(TblBD)
          clé = TblBD(i, 1) & "|" & TblBD(i, 2) & "|" & TblBD(i, 3) & "|" & TblBD(i, 4) & "|" & "" & "|" & "" & "|" & "" & "|" & Month(CDate(TblBD(i, 5)))
          d(clé) = d(clé) + (X + 1)
          Next i
  F1.Range("H5").Resize(d.Count) = Application.Transpose(d.keys)
  Application.DisplayAlerts = False
  F1.Range("H5").Resize(d.Count).TextToColumns Other:=1, DataType:=xlDelimited, OtherChar:="|"
  F1.Range("N5").Resize(d.Count) = Application.Transpose(d.items)
 
Dim derlig As Long
Dim L As Long
derlig = F1.Cells(Rows.Count, 8).End(xlUp).Row
Dim Lig As Long
 For j = 5 To derlig
 ActiveSheet.ListObjects("Tab_ListeArrets").Range.AutoFilter Field:=1, Criteria1:=F1.Cells(j, "H")
 ActiveSheet.ListObjects("Tab_ListeArrets").Range.AutoFilter Field:=6, Criteria1:=F1.Cells(j, "O")
 
Lig = Range("Tab_ListeArrets").SpecialCells(xlCellTypeVisible).Row
Nblig = Range("Tab_ListeArrets").SpecialCells(xlCellTypeVisible).Rows.Count
ligfin = [A:A].Find("*", , xlValues, , xlByRows, xlPrevious).Row
 
If F1.Cells(j, "H") <> "" Then
F1.Cells(j, "L") = F1.Cells(Lig, 5)
F1.Cells(j, "M") = F1.Cells(ligfin, 5)
End If
 
   With ActiveSheet.ListObjects("Tab_ListeArrets")
        If .ShowAutoFilter Then
            If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
        Else
            .ShowAutoFilter = True
        End If
    End With
 
Next j
 
  F1.Range("L5:M" & derlig).NumberFormat = "m/d/yyyy"
 
  Application.ScreenUpdating = True
  End Sub