XL 2016 [Résolu] Sommation de nombre de jours sous conditions

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
kingfadhel

kingfadhel

XLDnaute Impliqué
Bonjour, les XLdnautes,
Je voudrais faire la somme du nombre de jours sous conditions
1- Le même matricule, un ou plusieurs (CODE, DATE DEBUT, DATE FIN)
2- Suppression des lignes inutiles.

Plus de détails dans la pièce jointe.
 

Pièces jointes

Trier par date Trier par votes
Re,

J'ai ajouté les Application.Calculation pour éviter le recalcul des formules volatiles (DECALER).

J'ai recopié le tableau sur 3200 lignes (avec des matricules différents).

La macro s'exécute chez moi sur Win 10 Excel 2013 en 1,8 seconde.

A+
 
Vote positif 0 Vote négatif
Re,

Avec un tableau VBA c'est plus rapide :
Code: 
Private Sub Worksheet_Activate()
Dim t, ub&, i&, j&
Application.ScreenUpdating = False
With Feuil1.[A1].CurrentRegion 'à adapter
  If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
  .Sort .Columns(2), xlAscending, .Columns(5), , xlAscending, Header:=xlYes 'tri
  .EntireColumn.Copy [A1]
End With
Application.Calculation = xlCalculationManual 'évite le recalcul des formules volatiles
With [A1].CurrentRegion
  .Value = .Value 'supprime les formules
  .Columns(7).Resize(, 2).EntireColumn.Delete
  t = .Columns(6).Resize(, 2): ub = UBound(t)
  For i = 2 To ub
    If t(i, 2) = "" Then
      For j = i + 1 To ub
        If t(j, 2) <> "" Then Exit For
      Next j
      t(i, 1) = t(j, 1): t(i, 2) = t(j, 2): t(j, 2) = ""
      i = j
    End If
  Next i
  .Columns(6).Resize(, 2) = t 'restitution
  On Error Resume Next 'si aucune SpecialCell
  .Columns(7).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Application.Calculation = xlCalculationAutomatic
With UsedRange: End With 'actualise les barres de défilement
End Sub
Fichier (2).

Sur 3200 enregistrements => 0,96 seconde.

Edit : j'ai essayé de mettre le résultat en Feuil1 mais alors la MFC pose problème.

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re,

Les formules en H2 et I2 sont élémentaires , il faut bien sûr avoir inséré d'abord la colonne A.

Pour trier sur 4 colonnes il faut une autre syntaxe, utilisez l'enregistreur de macro.

Mais je n'en vois pas du tout l'intérêt : une même personne ne va pas avoir un autre accident pendant sa période d'arrêt ! Donc le tri sur 2 colonnes doit suffire.

A+
 
Vote positif 0 Vote négatif
Bonjour kingfadhel, le forum,
job75 à dit:
Edit : j'ai essayé de mettre le résultat en Feuil1 mais alors la MFC pose problème.
Cliquez pour agrandir...
Oui mais j'y suis quand même arrivé.

1) En modifiant la formule de la MFC :
Code: 
=MOD(SI(COLONNE()<12;$A2;$L2);2)
2) En utilisant un document auxiliaire :
Code: 
Sub Regroupement()
Dim F As Worksheet, t, ub&, i&, j&
Set F = ActiveSheet
Application.ScreenUpdating = False
With F.[A1].CurrentRegion 'à adapter
  If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
  .Sort .Columns(2), xlAscending, .Columns(5), , xlAscending, Header:=xlYes 'tri
  .EntireColumn.Copy Workbooks.Add.Sheets(1).[L1] 'document auxiliaire, à adapter
End With
Application.Calculation = xlCalculationManual 'évite le recalcul des formules volatiles
With ActiveWorkbook.Sheets(1).[L1].CurrentRegion
  .Value = .Value 'supprime les formules
  .Columns(7).Resize(, 2).EntireColumn.Delete
  t = .Columns(6).Resize(, 2): ub = UBound(t)
  For i = 2 To ub
    If t(i, 2) = "" Then
      For j = i + 1 To ub
        If t(j, 2) <> "" Then Exit For
      Next j
      t(i, 1) = t(j, 1): t(i, 2) = t(j, 2): t(j, 2) = ""
      i = j
    End If
  Next i
  .Columns(6).Resize(, 2) = t 'restitution
  On Error Resume Next 'si aucune SpecialCell
  .Columns(7).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  .EntireColumn.Copy F.[L1]
End With
ActiveWorkbook.Close False 'fermeture du document auxiliaire
Application.Calculation = xlCalculationAutomatic
End Sub
Fichier (3).

Sur 3200 enregistrements c'est un peu plus long => 1,6 seconde.

Bonne journée.
 

Pièces jointes

Vote positif 0 Vote négatif
job75 à dit:
Bonjour kingfadhel, le forum,

Oui mais j'y suis quand même arrivé.

1) En modifiant la formule de la MFC :
Code: 
=MOD(SI(COLONNE()<12;$A2;$L2);2)
2) En utilisant un document auxiliaire :
Code: 
Sub Regroupement()
Dim F As Worksheet, t, ub&, i&, j&
Set F = ActiveSheet
Application.ScreenUpdating = False
With F.[A1].CurrentRegion 'à adapter
  If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
  .Sort .Columns(2), xlAscending, .Columns(5), , xlAscending, Header:=xlYes 'tri
  .EntireColumn.Copy Workbooks.Add.Sheets(1).[L1] 'document auxiliaire, à adapter
End With
Application.Calculation = xlCalculationManual 'évite le recalcul des formules volatiles
With ActiveWorkbook.Sheets(1).[L1].CurrentRegion
  .Value = .Value 'supprime les formules
  .Columns(7).Resize(, 2).EntireColumn.Delete
  t = .Columns(6).Resize(, 2): ub = UBound(t)
  For i = 2 To ub
    If t(i, 2) = "" Then
      For j = i + 1 To ub
        If t(j, 2) <> "" Then Exit For
      Next j
      t(i, 1) = t(j, 1): t(i, 2) = t(j, 2): t(j, 2) = ""
      i = j
    End If
  Next i
  .Columns(6).Resize(, 2) = t 'restitution
  On Error Resume Next 'si aucune SpecialCell
  .Columns(7).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  .EntireColumn.Copy F.[L1]
End With
ActiveWorkbook.Close False 'fermeture du document auxiliaire
Application.Calculation = xlCalculationAutomatic
End Sub
Fichier (3).

Sur 3200 enregistrements c'est un peu plus long => 1,6 seconde.

Bonne journée.
Cliquez pour agrandir...


Bonjour, le forum
@job75 , Merci pour le temps consacré.
 
Vote positif 0 Vote négatif
Bonjour kingfadhel, le forum,

Encore 2 améliorations dans ce fichier (4).

1) En nommant N° la 1ère cellule du tableau et en définissant le nom decal, formule de la MFC :
Code: 
=MOD(DECALER(N°;LIGNE()-LIGNE(N°);decal*(COLONNE()>=COLONNE(N°)+decal););2)
La macro Regroupement est bien sûr adaptée en conséquence.

2) Cette macro supprime la ligne du tableau si la formule en dernière colonne est effacée :
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If ListObjects.Count = 0 Then Exit Sub
On Error Resume Next
With ListObjects(1).DataBodyRange
  Intersect(.Cells, .Columns(.Columns.Count).SpecialCells(xlCellTypeBlanks).EntireRow).Delete xlUp
End With
End Sub
Au cas où vous ne l'auriez pas vu il y a aussi une macro Workbook_Open, assez utile.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

H
  • Question Question
XL 2010 calcul du nombre de jours en fonction des dates
Réponses
8
Affichages
279
job75
job75
B
  • Question Question
Microsoft 365 Protection de zone de cellule selon utilisateur sur un fichier Excel
Réponses
2
Affichages
164
berta8683
B
bataggone
  • Question Question
XL 2019 Une formule sur Excel qui me permis de calculer le nombre de jours de congé avec queqlques conditions
Réponses
4
Affichages
260
job75
job75
C
  • Question Question
XL 2016 Je cherche une formule pour une semaine à 4.5 jours au lieu de 5 jours
Réponses
3
Affichages
329
Cancan666
C
Agecanonix35400
  • Question Question
XL 2016 * RESOLU *Automatisation jours de récup
Réponses
2
Affichages
112
Agecanonix35400
Agecanonix35400
B
  • Question Question
XL 2021 Formule suivi de data
Réponses
9
Affichages
257
Dand87
D
M
  • Résolu(e)
Autres calcul de présence
Réponses
3
Affichages
198
micke32
M
C
  • Question Question
Microsoft 365 Calcul de la répartition de prime
Réponses
2
Affichages
294
CathU
C
treza88
  • Question Question
Microsoft 365 VBA : Problème de reconnaissance de variable avec fonction FIND
Réponses
2
Affichages
244
Dranreb
Dranreb
L
  • Question Question
XL 2013 tableau de compta
Réponses
12
Affichages
292
sylvanu
sylvanu
Armisa
  • Résolu(e)
XL 2016 Formule EXCEL pour calculer le nombre de voyages
Réponses
2
Affichages
223
Armisa
Armisa
B
  • Question Question
XL 2021 [Résolu] Date de départ et calcul des jours ouvrés
Réponses
4
Affichages
198
Bibinaire
B
F
  • Question Question
Microsoft 365 Problème RECHERCHEV avec plusieurs correspondances possibles pour une même valeur
2
Réponses
15
Affichages
616
floflatch22
F
S
  • Question Question
XL 2016 Création de factures à parti d'un tableau
Réponses
5
Affichages
222
sfconstant
S
K
  • Question Question
Microsoft 365 Excel - Répartition Charge de travail (mensuel)
Réponses
10
Affichages
567
Kristelle1555
K
W
  • Question Question
XL 2019 Transformer des lignes de codes pour pratiquer Tablo à 4 colonnes et 40 lignes
2 3
Réponses
40
Affichages
1 K
Webperegrino
W
C
  • Question Question
XL 2010 Recherche de colonne et calcul sur 2 années consécutives
Réponses
0
Affichages
341
CS49
C
J
  • Résolu(e)
Microsoft 365 Problème de décompte avec PQ
Réponses
8
Affichages
453
José FELIX
J
A
  • Question Question
Power Pivot calcule heur moyenne de début de travaille
Réponses
3
Affichages
288
aminouuu
A
U
  • Résolu(e)
Microsoft 365 planning étude
Réponses
5
Affichages
235
bsalv
B
Retour