Synthèse des absences

[eduraiss]

Bonjour le forum

Voici en exemple ce qui me serait très utile

Avoir la synthèse des absences d'un salariés

Voir le fichier avec les explications

merci a vous

 

[phlaurent55]

Re : Synthèse des absences

Bonjour eduraiss

voir fichier joint

à+
Philippe

 

[job75]

Re : Synthèse des absences

Bonsoir eduraiss, salut Philippe,

Une autre manière de faire mais le résultat est le même :

Private Sub Worksheet_BeforeDoubleclick(ByVal Target As Range, Cancel As Boolean)
If Target.Row < 5 Or Target.Column <> 2 Then Exit Sub
Cancel = True
With Feuil1 'CodeName de la feuille
  .[A1] = Target & " " & Target(, 2)
  .[A2:A236] = Application.Transpose([V4:IV4])
  .[B2:B236] = Application.Transpose(Intersect(Target.EntireRow, [V:IV]))
  .[B2:B236].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  .Activate
End With
End Sub

Edit : j'avais mis au début .Cells.ClearContents mais ça ne sert à rien ici.

Fichier joint.

A+

 

[job75]

Re : Synthèse des absences

Bonjour eduraiss, Philippe,

Si l'on est sur Excel 2007/2010/2013 avec 16384 colonnes, utiliser :

Private Sub Worksheet_BeforeDoubleclick(ByVal Target As Range, Cancel As Boolean)
If Target.Row < 5 Or Target.Column <> 2 Then Exit Sub
Dim n%
Cancel = True
With Feuil1 'CodeName de la feuille
  .[A1] = Target & " " & Target(, 2)
  n = .Columns.Count - 21
  .[A2].Resize(n) = Application.Transpose([V4].Resize(, n))
  .[B2].Resize(n) = _
    Application.Transpose(Intersect(Target.EntireRow, [V:V].Resize(, n)))
  .[B2].Resize(n).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  .Activate
End With
End Sub

qui fonctionne sur toute version.

Fichier (2).

A+

 

[job75]

Re : Synthèse des absences

Re,

Pour peaufiner, un complément qui ajuste la barre de défilement verticale :

Private Sub Worksheet_BeforeDoubleclick(ByVal Target As Range, Cancel As Boolean)
If Target.Row < 5 Or Target.Column <> 2 Then Exit Sub
Dim n%
Cancel = True
With Feuil1 'CodeName de la feuille
  .[A1] = Target & " " & Target(, 2)
  n = Columns.Count - 21
  .[A2].Resize(n) = Application.Transpose([V4].Resize(, n))
  .[B2].Resize(n) = _
    Application.Transpose(Intersect(Target.EntireRow, [V:V].Resize(, n)))
  .[B2].Resize(n).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  Set Target = .UsedRange 'ajuste la barre de défilement verticale
  .Activate
End With
End Sub

Fichier (3).

A+

 

[eduraiss]

Re : Synthèse des absences

Bonjour le forum
Une grand merci a vous, il seul petit truc sur la feuill1 j'aimerais avoir en colonne D le nombre de jour le (maladie, congés, rtt ,etc)

Je ne peux pas mettre de formule car la feuill1 est effacée avec le code

Donc si cela est possible avoir un effacement des colonnes A et B

Merci encore

 

[eduraiss]

Re : Synthèse des absences

Re

et si possible que l'effacement n'efface pas le format que je vais mettre

merci encore

 

[job75]

Re : Synthèse des absences

Re,

Mes codes précédents n'effacent rien, et votre demande n'est pas claire, mais voyez ceci :

Private Sub Worksheet_BeforeDoubleclick(ByVal Target As Range, Cancel As Boolean)
If Target.Row < 5 Or Target.Column <> 2 Then Exit Sub
Dim n%, d As Object, c As Range
Cancel = True
With Feuil1 'CodeName de la feuille
  .[1:2].ClearContents
  .[A1] = Target & " " & Target(, 2)
  n = Columns.Count - 21
  .[A2].Resize(n) = Application.Transpose([V4].Resize(, n))
  .[B2].Resize(n) = _
    Application.Transpose(Intersect(Target.EntireRow, [V:V].Resize(, n)))
  .[B2].Resize(n).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  Set Target = .UsedRange 'ajuste la barre de défilement verticale
  Set d = CreateObject("Scripting.Dictionary")
  n = 3
  For Each c In Target.Columns(2).Cells
    If c <> "" And Not d.exists(c.Value) Then
      n = n + 1
      d(c.Value) = ""
      .Cells(1, n) = c
      .Cells(2, n) = Application.CountIf(Target.Columns(2), c)
      .Columns(n).AutoFit 'ajustement automatique
    End If
  Next
  .Activate
End With
End Sub

Edit : ajouté l'ajustement automatique des colonnes.

Fichier (4).

A+

 

[eduraiss]

Re : Synthèse des absences

Re

Merci a vous job 75

C'est exactement ce qu'il me faut sauf que cela m'enlève le format que le mets sur la feuill1
Les couleurs le format date
Voila sinon c'est nickel

Merci

 

[job75]

Re : Synthèse des absences

Re,

Si vous mettez des formats mettez les d'abord sur une colonne entière.

Puis formatez la ligne 1.

A+

 

[job75]

Re : Synthèse des absences

Re,

Vous préférerez peut-être cette nouvelle présentation avec cette macro :

Private Sub Worksheet_BeforeDoubleclick(ByVal Target As Range, Cancel As Boolean)
If Target.Row < 5 Or Target.Column <> 2 Then Exit Sub
Dim n%, d As Object, c As Range
Cancel = True
With Feuil1 'CodeName de la feuille
  .[A1] = Target & " " & Target(, 2)
  n = Columns.Count - 21
  .[A2].Resize(n) = Application.Transpose([V4].Resize(, n))
  .[B2].Resize(n) = _
    Application.Transpose(Intersect(Target.EntireRow, [V:V].Resize(, n)))
  .[B2].Resize(n).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  .[D2:E2].Resize(n).ClearContents
  Set Target = .UsedRange 'ajuste la barre de défilement verticale
  Set d = CreateObject("Scripting.Dictionary")
  n = 1
  For Each c In Target.Columns(2).Cells
    If c <> "" And Not d.exists(c.Value) Then
      n = n + 1
      d(c.Value) = ""
      .Cells(n, 4) = c
      .Cells(n, 5) = Application.CountIf(Target.Columns(2), c)
    End If
  Next
  .Columns(4).AutoFit 'ajustement automatique
  .Activate
End With
End Sub

Fichier (5), voyez les MFC en colonnes D et E.

A+

 

[eduraiss]

Re : Synthèse des absences

Re

Vraiment merci beaucoup pour cette automatisation

Bien cordialement,