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
job75

job75

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

Bonjour Christian,

Dans ce genre de problème il faut être très précis dans l'utilisation des tests :

Code: 
Function NbFract(P As Range)
Dim dat&, test1 As Boolean, i As Variant, test2 As Boolean, n&
For dat = Application.Min(P.Columns(1)) To Application.Max(P.Columns(1))
  test1 = Weekday(dat, 2) > 5 Or Application.CountIf([Férié], dat)
  i = Application.Match(dat, P.Columns(1), 0)
  test2 = False
  If IsNumeric(i) Then If P(i, 2) Like "CA*" Then test2 = True
  If n And test1 Or test2 Then
    n = n + 1
  Else
    If n >= 5 Then NbFract = NbFract + 1
    n = 0
  End If
Next
End Function
Fichier joint avec la fonction utilisée en E2 =NbFract(B:C)

A+
 

Pièces jointes

  • CompterValeursConsécutivesSelonCritères(1).xls
    91.5 KB · Affichages: 26
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,

Ah oui bien sûr, il faut compter aussi la dernière série :

Code: 
Function NbFract(P As Range)
Dim dat&, test1 As Boolean, i As Variant, test2 As Boolean, n&
For dat = Application.Min(P.Columns(1)) To Application.Max(P.Columns(1))
  test1 = Weekday(dat, 2) > 5 Or Application.CountIf([Férié], dat)
  i = Application.Match(dat, P.Columns(1), 0)
  test2 = False
  If IsNumeric(i) Then If P(i, 2) Like "CA*" Then test2 = True
  If n And test1 Or test2 Then
    n = n + 1
  Else
    If n >= 5 Then NbFract = NbFract + 1
    n = 0
  End If
Next
If n >= 5 Then NbFract = NbFract + 1 'dernière série
End Function
Fichier (2) où j'ai ajouté des dates en novembre.

A+
 

Pièces jointes

  • CompterValeursConsécutivesSelonCritères(2).xls
    91.5 KB · Affichages: 34
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'il est sans doute utile de délimiter la plage étudiée.

Sur mon ordi Win XP - Excel 2003 la formule =NbFract(B:C) s'exécute en 0,376 seconde.

Et =NbFract(B3:C29) s'exécute en 0,031 seconde...

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,

Bonsoir à tous,

Je te remercie infiniment pour ce beau boulot (comme d'hab).
Ok pour ton conseil post 4, je vais délimiter la plage pour gagner du temps de calcul.

Encore un grand merci.
Salut l'artiste.

Bien à toi.
Christian
 
Vote positif 0 Vote négatif
job75

job75

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

Re,

Et comme d'hab j'améliore.

Les Application.Match prennent du temps, voici une fonction beaucoup plus rapide :

Code: 
Function NbFract(P As Variant, Nserie As Byte)
Dim fer As Range, mini&, maxi&, a$(), i&, dat&, test As Boolean, n&
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
  test = Weekday(dat, 2) > 5 Or Application.CountIf(fer, dat)
  If n And test Or a(dat - mini) Like "CA*" Then
    n = n + 1
  Else
    If n >= Nserie Then NbFract = NbFract + 1
    n = 0
  End If
Next
If n >= Nserie Then NbFract = NbFract + 1 'dernière série
End Function
Les tableaux VBA, surtout a, font gagner beaucoup de temps.

Fichier (3).

=NbFract(B:C;5) s'exécute en 6,6 millisecondes

=NbFract(B3:C29;5) s'exécute en 6,1 millisecondes...

A+
 

Pièces jointes

  • CompterValeursConsécutivesSelonCritères(3).xls
    94 KB · Affichages: 29
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,

Il peut être utile de savoir comment on détermine la durée d'exécution :

- rendre volatile la fonction :

Code: 
Function NbFract(P As Range)
Application.Volatile 'pour tester
'-------
- lancer cette macro :

Code: 
Sub Durée()
Dim t#, n
Application.ScreenUpdating = False
t = Timer
For n = 1 To 1000 'à adapter
Calculate
Next
MsgBox "Durée " & Format(1000 * (Timer - t) / (n - 1), "0.0") & " millisecondes"
End Sub
Bien entendu neutraliser les autres fonctions volatiles du classeur.

Bonne nuit et 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,

Merci, job75, pour la version améliorée post6 et pour les test et explications sur la rapidité d'exécution post7.

Dis-moi, peux-tu me dire, dans le fichier2 ci-joint, il me semble que le calcul n'est pas bon.?

A te lire,
Bien à toi.
Christian
 

Pièces jointes

  • CompterValeursConsécutivesSelonCritère2.zip
    27.4 KB · Affichages: 23
Vote positif 0 Vote négatif
job75

job75

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

Bonjour Christian,

Il y a une série de 5 jours consécutifs du 10 au 14 novembre puisque le 11 novembre est férié.

Comme je l'ai dit, c'est la dernière ligne de la macro qui la récupère.

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,

Ok, mais le critère c'est ; 5 dates consécutives si un CA est posé sur ces 5 dates... du 10 au 14 novembre il y a 4 CA posés pour ces 4 dates, certe ça fait 5 jours consécutifs avec le férié du 11, mais le critère "si 5 dates et si 5 CA consécutifs n'est pas respecté dans ce cas...

à te lire,

Christian
 
Vote positif 0 Vote négatif
job75

job75

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

Re,

Je ne comprends pas ton post #10.

A priori les jours fériés sont à traiter comme les week-ends, il y a 5 jours de CA consécutifs, point barre.

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

Dans le post 10, il y a un congé posé du 10 au 14 novembre soit 4 jours de CA et non 5... donc ce n'est pas une séquence de 5 CA, la notion de "consécutifs" s' appliquerait, dans ce cas, si je posais du 10 au 17 novembre (soit 5 dates considérées consécutives, entercalées entre 11 nov et le samedi 16 et dimanche 17) soit 5 CA posés.

A te lire.
Christian
 
Vote positif 0 Vote négatif
job75

job75

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

Re,

Bon je comprends que dans le comptage d'une série tu comptes seulement les "CA" inscrits.

Alors il faut modifier les tests :

Code: 
Function NbFract(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 "CA*" 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
Fichier (4).

A+
 

Pièces jointes

  • CompterValeursConsécutivesSelonCritères(4).xls
    95 KB · Affichages: 36
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

tactic6
  • Question
XL 2016 Ajout fonction sur userform Boisgontiers RESOLU
Réponses
3
Affichages
229
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
181
7outils
7
C
  • Question
Microsoft 365 Transposer des valeurs en 2 colonnes en fonction d'une référence produit
Réponses
9
Affichages
301
Cagnet
C
A
  • Question
XL 2019 Filtre avancé en VBA
Réponses
12
Affichages
304
Amilo
A
K
  • Résolu(e)
XL 2013 Remplacement texte sous conditions
Réponses
5
Affichages
250
komarlehomard
K
T
  • Question
XL 2016 La macro efface les formules
Réponses
3
Affichages
239
JHA
J
D
  • Question
XL pour MAC [RESOLU]Cacher ou afficher colonnes, sauf colonne selectionné
Réponses
9
Affichages
469
Dudy
D
E
  • Question
Microsoft 365 Compter le nombre de valeurs différentes d'une colonne
Réponses
6
Affichages
582
R@chid
R@chid
L
  • Question
Autres Macro pour conevrtir des lignes excel en CSV
Réponses
3
Affichages
160
sylvanu
sylvanu
J
  • Question
XL 2016 macro pour remplir un calendrier à partir d'une liste d'évènements
Réponses
3
Affichages
365
julien6337
J

Membres actuellement en ligne

13 membres et 195 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 194
Messages
2 086 064
Membres
103 110
dernier inscrit
Privé