Macro pour compter des valeurs consécutives sur calendrier en colonne...

C

Christian0258

XLDnaute Accro
Bonjour à tous,

Je souhaiterais votre aide afin d'écrire un macro pour compter si 5 dates consécutives (colonnes B) en fonction de critères (colonne C), et sous conditions...

voir fichier joint.

Je vous remercie, par avance, pour le temps que vous voudrez bien vouloir m'accorder.

Bien à vous,
Christian
 

Pièces jointes

  • CompterValeursConsécutivesSelonCritères.zip
    29.9 KB · Affichages: 35
Trier par date Trier par votes
C

Christian0258

XLDnaute Accro
Re : Macro pour compter des valeurs consécutives sur calendrier en colonne...

Re, le forum, job75,

Je reviens sur ce fil, j'aurais une petite modif à réaliser sur le code de job75....

-comment modifier cette partie de code ; If a(dat - mini) Like "CA*" Then pour considérer, dans la recherche, deux autres types de congés ("CHS" et "CF") donc en plus des "CA*"....

Merci pour votre aide si précieuse.

Bien à vous,
Christian
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Macro pour compter des valeurs consécutives sur calendrier en colonne...

Bonjour Christian,

Si tu veux un résultat séparé pour chaque texte "CA", "CHS" et "CF" il suffit d'ajouter un argument supplémentaire :

Code: 
Function NbFract(t$, P As Variant, Nserie As Byte)
Dim fer As Range, mini&, maxi&, a$(), i&, dat&, n&, test As Boolean
Set fer = [Férié]
'---liste des textes associés aux dates---
mini = Application.Min(P): maxi = Application.Max(P)
ReDim a(maxi - mini) 'base 0
P = Intersect(P, P.Parent.UsedRange) 'matrice, plus rapide
For i = 1 To UBound(P)
  If IsDate(P(i, 1)) Then a(P(i, 1) - mini) = P(i, 2)
Next
'---comptage des séries---
For dat = mini To maxi
  If a(dat - mini) Like t & "*" Then
    n = n + 1
  ElseIf n Then
    test = Weekday(dat, 2) > 5 Or Application.CountIf(fer, dat)
    If Not test Then
      If n >= Nserie Then NbFract = NbFract + 1
      n = 0
    End If
  End If
Next
If n >= Nserie Then NbFract = NbFract + 1 'dernière série
End Function
et d'entrer en E2 =NbFract("CA";B:C;5) ou =NbFract("CHS";B:C;5)

Si par contre tu veux "globaliser" tous les types de congés :

Code: 
Function NbFract(P As Variant, Nserie As Byte)
Dim fer As Range, mini&, maxi&, a$(), i&, dat&, t$, n&, test As Boolean
Set fer = [Férié]
'---liste des textes associés aux dates---
mini = Application.Min(P): maxi = Application.Max(P)
ReDim a(maxi - mini) 'base 0
P = Intersect(P, P.Parent.UsedRange) 'matrice, plus rapide
For i = 1 To UBound(P)
  If IsDate(P(i, 1)) Then a(P(i, 1) - mini) = P(i, 2)
Next
'---comptage des séries---
For dat = mini To maxi
  t = a(dat - mini)
  If t Like "CA*" Or t Like "CHS*" Or t Like "CF*" Then
    n = n + 1
  ElseIf n Then
    test = Weekday(dat, 2) > 5 Or Application.CountIf(fer, dat)
    If Not test Then
      If n >= Nserie Then NbFract = NbFract + 1
      n = 0
    End If
  End If
Next
If n >= Nserie Then NbFract = NbFract + 1 'dernière série
End Function
A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Macro pour compter des valeurs consécutives sur calendrier en colonne...

Re,

Mieux, si tu veux "globaliser" de différentes manières, utilise :

Code: 
Function NbFract(P As Variant, Nserie As Byte, t1$, _
  Optional t2$ = "zzz", Optional t3$ = "zzz")
Dim fer As Range, mini&, maxi&, a$(), i&, dat&, t$, n&, test As Boolean
Set fer = [Férié]
'---liste des textes associés aux dates---
mini = Application.Min(P): maxi = Application.Max(P)
ReDim a(maxi - mini) 'base 0
P = Intersect(P, P.Parent.UsedRange) 'matrice, plus rapide
For i = 1 To UBound(P)
  If IsDate(P(i, 1)) Then a(P(i, 1) - mini) = P(i, 2)
Next
'---comptage des séries---
For dat = mini To maxi
  t = a(dat - mini)
  If t Like t1 & "*" Or t Like t2 & "*" Or t Like t3 & "*" Then
    n = n + 1
  ElseIf n Then
    test = Weekday(dat, 2) > 5 Or Application.CountIf(fer, dat)
    If Not test Then
      If n >= Nserie Then NbFract = NbFract + 1
      n = 0
    End If
  End If
Next
If n >= Nserie Then NbFract = NbFract + 1 'dernière série
End Function
avec par exemple en E2 =NbFract(B:C;5;"CA";"CHS")

A+
 
Vote positif 0 Vote négatif
C

Christian0258

XLDnaute Accro
Re : Macro pour compter des valeurs consécutives sur calendrier en colonne...

Re, le forum, job75,

Bonjour à tous,

Je reviens, à nouveau sur ce fil, pour un petit problème...

Je travaille avec le "calendrier 1904" coché et dans ce cas la fonction, de job75, me note un message d'erreur type "#VALEUR!"...

Pourriez-me dire...
voir fichier.

Je vous remercie pour le temps que vous voudrez bien vouloir m'accorder.

Bien amicalement,
Christian
 

Pièces jointes

  • CompterValeursConsécutivesSelonCritères(5).xls
    88 KB · Affichages: 19
  • CompterValeursConsécutivesSelonCritères(5).xls
    88 KB · Affichages: 19
  • CompterValeursConsécutivesSelonCritères(5).xls
    88 KB · Affichages: 20
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Macro pour compter des valeurs consécutives sur calendrier en colonne...

Bonjour Christian,

Comme déjà dit sur un autre fil, avec le calendrier 1904 VBA convertit les dates au calendrier 1900.

La fonction modifiée avec la variable decal :

Code: 
Function NbFract(P As Variant, Nserie As Byte, t1$, _
  Optional t2$ = "zzz", Optional t3$ = "zzz")
Dim fer As Range, decal#, mini&, maxi&, a$(), i&, dat&, t$, n&, test As Boolean
Set fer = [Férié]
decal = -1462 * ThisWorkbook.Date1904 'decal est >= 0
'---liste des textes associés aux dates---
mini = Application.Min(P): maxi = Application.Max(P)
ReDim a(maxi - mini) 'base 0
P = Intersect(P, P.Parent.UsedRange) 'matrice, plus rapide
For i = 1 To UBound(P)
  If IsDate(P(i, 1)) Then a(P(i, 1) - decal - mini) = P(i, 2)
Next
'---comptage des séries---
For dat = mini To maxi
  t = a(dat - mini)
  If t Like t1 & "*" Or t Like t2 & "*" Or t Like t3 & "*" Then
    n = n + 1
  ElseIf n Then
    test = Weekday(dat + decal, 2) > 5 Or Application.CountIf(fer, dat)
    If Not test Then
      If n >= Nserie Then NbFract = NbFract + 1
      n = 0
    End If
  End If
Next
If n >= Nserie Then NbFract = NbFract + 1 'dernière série
End Function
Ton fichier en retour.

Bien entendu tu sais que les jours fériés pour 2018 ne sont pas corrects : 15 juillet, 16 août...

A+
 

Pièces jointes

  • CompterValeursConsécutivesSelonCritères(5).xls
    89.5 KB · Affichages: 20
  • CompterValeursConsécutivesSelonCritères(5).xls
    89.5 KB · Affichages: 20
  • CompterValeursConsécutivesSelonCritères(5).xls
    89.5 KB · Affichages: 21
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Macro pour compter des valeurs consécutives sur calendrier en colonne...

Re,

Note qu'avec ce fichier (5 bis) on obtient le même résultat.

decal est utilisé différemment, ça t'aidera à mieux comprendre ce qui se passe.

A+
 

Pièces jointes

  • CompterValeursConsécutivesSelonCritères(5 bis).xls
    89.5 KB · Affichages: 26
Vote positif 0 Vote négatif
C

Christian0258

XLDnaute Accro
Re : Macro pour compter des valeurs consécutives sur calendrier en colonne...

Re, le forum,

Je reviens sur ce fil, et le travail de job75, car je souhaiterais appliquer la fonction sur plusieurs colonnes et non une seule...

voir fichier joint

Merci pour le temps que vous voudrez bien vouloir m'accorder.

Bien amicalement,
Christian
 

Pièces jointes

  • Cpter CA consécutifs V6.xlsm
    48.7 KB · Affichages: 20
  • Cpter CA consécutifs V6.xlsm
    48.7 KB · Affichages: 21
  • Cpter CA consécutifs V6.xlsm
    48.7 KB · Affichages: 21
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Macro pour compter des valeurs consécutives sur calendrier en colonne...

Bonjour Christian, le forum,

Il suffit d'une plage "extensible" en B15, C15 etc =NbFract($A$18:B$15000;5;"CA";"CHS";"CF")

Et dans la macro de traiter la dernière colonne ncol :

Code: 
ncol = P.Columns.Count 'dernière colonne
ReDim a(maxi - mini) 'base 0
P = Intersect(P, P.Parent.UsedRange) 'matrice, plus rapide
For i = 1 To UBound(P)
  If IsDate(P(i, 1)) Then a(P(i, 1) - decal - mini) = P(i, ncol)
Next
Ton fichier en retour avec résultat 0 en C15...

A+
 

Pièces jointes

  • Cpter CA consécutifs V6.xlsm
    50.5 KB · Affichages: 26
  • Cpter CA consécutifs V6.xlsm
    50.5 KB · Affichages: 27
  • Cpter CA consécutifs V6.xlsm
    50.5 KB · Affichages: 28
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Macro pour compter des valeurs consécutives sur calendrier en colonne...

Re,

En passant, note que dans ton fichier le UsedRange va - inutilement - jusqu'à la ligne 2261.

Les calculs seront donc plus rapides en remplaçant :

Code: 
P = Intersect(P, P.Parent.UsedRange) 'matrice, plus rapide
par :

Code: 
P = P.Resize(Application.Match(9 ^ 9, P.Columns(1))) 'matrice, plus rapide
A+
 
Vote positif 0 Vote négatif
C

Christian0258

XLDnaute Accro
Re : Macro pour compter des valeurs consécutives sur calendrier en colonne...

Re le forum, job75,

Bonjour à tout le forum,

Merci, job75, pour cette adaptation et les précisions...

Comme d'hab, c'est parfaitement, parfait.

Encore un grand merci.
Bien à toi,
Christian
 
Vote positif 0 Vote négatif
C

Christian0258

XLDnaute Accro
Re : Macro pour compter des valeurs consécutives sur calendrier en colonne...

Re, le forum, job75
Bonjour à tout le forum,

J'ai encore une tite amélioration à vous demander...

Dans le fichier joint, issue des dernières modifs de job75, je souhaiterais préciser à la fonction "(NbFract($A$18:B$15000;5;"CA";"CHS";"CF")" de compter sur l'année indiquer en cellule V1...

Merci à vous pour votre aide si précieuse.
Bien amicalement,
Christian
 

Pièces jointes

  • Cpter CA consécutifs V7.xlsm
    48.4 KB · Affichages: 18
  • Cpter CA consécutifs V7.xlsm
    48.4 KB · Affichages: 19
  • Cpter CA consécutifs V7.xlsm
    48.4 KB · Affichages: 22
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Macro pour compter des valeurs consécutives sur calendrier en colonne...

Bonjour Christian,

Bah, avec l'argument supplémentaire "an" :

Code: 
Function NbFract(an%, P As Variant, Nserie As Byte, t1$, _
  Optional t2$ = "zzz", Optional t3$ = "zzz")
'------
For i = 1 To UBound(P)
  If Year(P(i, 1)) = an Then a(P(i, 1) - decal - mini) = P(i, ncol)
Next
Ton fichier modifié.

A+
 

Pièces jointes

  • Cpter CA consécutifs V7.xlsm
    32.8 KB · Affichages: 22
  • Cpter CA consécutifs V7.xlsm
    32.8 KB · Affichages: 23
  • Cpter CA consécutifs V7.xlsm
    32.8 KB · Affichages: 23
Vote positif 0 Vote négatif

Discussions similaires

tactic6
  • Question
XL 2016 Ajout fonction sur userform Boisgontiers RESOLU
Réponses
3
Affichages
243
Lolote83
L
7
  • Résolu(e)
XL 2016 Formule pour calculer un index et la date de la précédente relève pour un suivi des consommations
Réponses
2
Affichages
197
7outils
7
C
  • Question
Microsoft 365 Transposer des valeurs en 2 colonnes en fonction d'une référence produit
Réponses
9
Affichages
315
Cagnet
C
A
  • Question
XL 2019 Filtre avancé en VBA
Réponses
12
Affichages
332
Amilo
A
K
  • Résolu(e)
XL 2013 Remplacement texte sous conditions
Réponses
5
Affichages
255
komarlehomard
K
T
  • Question
XL 2016 La macro efface les formules
Réponses
3
Affichages
257
JHA
J
D
  • Question
XL pour MAC [RESOLU]Cacher ou afficher colonnes, sauf colonne selectionné
Réponses
9
Affichages
495
Dudy
D
E
  • Question
Microsoft 365 Compter le nombre de valeurs différentes d'une colonne
Réponses
6
Affichages
606
R@chid
R@chid
L
  • Question
Autres Macro pour conevrtir des lignes excel en CSV
Réponses
3
Affichages
171
sylvanu
sylvanu
J
  • Question
XL 2016 macro pour remplir un calendrier à partir d'une liste d'évènements
Réponses
3
Affichages
377
julien6337
J

Membres actuellement en ligne

1 membres et 35 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 329
Messages
2 087 335
Membres
103 520
dernier inscrit
Azise