Calculer le nombre de date en fonction d'une condition.

Version imprimable

09/02/2015, 09h53
Mehdi8793

1 pièce(s) jointe(s)

Calculer le nombre de date en fonction d'une condition.

Bonjour à tous,

je suis actuellement dans le developpement d'une application, et je rencontre un problème qui m'embete.

Je souhaite tout simplement calculer le nombre de date compris entre le 1 et le 31 de chaque mois après un filtre par exemple, en fonction d'une colonne d'un autre onglet.

je souhaite calculer le nombre de d'A3C+PQO de la ligne de l'onglet indicateur UEC, en fonction de la colonne D de l'onglet chrono.

Par exemple: fair un filtre sur la colonne D de l'onglet chrono pour le mois de janvier 2015 et calculer le nombre de date présente afin de les ajouter a la ligne 9 de l'onglet indicateur UEC a partir de Janv 2015.( en automatique) Je n'y arrive absolument pas !!!!

Je vous remercie d'avance pour toute aide ou réfléxion.Pièce jointe 168472 Pièce jointe 168473

Je vous me le fichier en pj.
Pièce jointe 168472 Pièce jointe 168473

Cordialement
09/02/2015, 12h51
Daniel.C

Bonjour,

Il semble que le modérateur ait supprimé ta pièce jointe, conformément à la charte du forum. Tu vas devoir expliquer plus précisément ton problème. Tes dates sont elles en ligne ou en colonne ? S'il s'agit d'un filtre, tu peux compter les valeurs filtrées avec :

Code:

Application.SubTotal(103,Range(...

qui compte les valeurs visibles.

2 pièce(s) jointe(s)

Bonjour,

merci de votre réponse.

Je vais essayer d'etre plus clair. Je vous joint des imprimes écrans.

Je souhaite remplir la ligne "nb A3C+PQO" en ligne 9 de indicateur.
Pièce jointe 168499

Cela correspond à l'ensemble des dates des projets présent dans l'onglet chrono de la colonne D. La colonne D représente les dates.
Pièce jointe 168497

Pour janvier 2015 il doit me retourner un résultat 10. Hors j'aimerai en automatique. Par le biais d'une macro. J'ai réussis a intégrer les autres valeurs "nb cotation V""nb cotation R" ... à l'aide de cette macro:

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
54
55
56
57
58
59
60
Public Function Fonction_Qui_Compte_Les_Couleurs()
 
 
Dim dateChrono As Date
 
Dim derlign As Integer
 
derlign = Worksheets("chrono").Range("A10000").End(xlUp).Row ' on va chercher la derniere ligne utilisée de la colonne A
 
 'init des valeurs
        Worksheets("Indicateur UEC").Range("i9:t13") = ""
 
 
    For i = 48 To derlign 'on va parcourir du début de la colonne jusqu'à la dernière ligne identifiée
 
        For j = 9 To 20
 
 
 
        dateChrono = Worksheets("chrono").Range("D" & i).Value
        dateIndicateur = Worksheets("Indicateur UEC").Cells(8, j).Value
 
        If Month(dateChrono) = Month(dateIndicateur) Then 'On compare les mois
 
 
        If Worksheets("chrono").Range("D" & i).Value = Month(dateIndicateur) Then
        Worksheets("Indicateur UEC").Cells(9, j).Value = Worksheets("Indicateur UEC").Cells(10, j).Value + 1
 
         End If
        'Si la valeur de ma colonne est "V" (identifiée en Vert) alors j'ajoute +1 à mon compteur
        If Worksheets("chrono").Range("F" & i).Value = "V" Or Worksheets("chrono").Range("F" & i).Value = "v" Then
        Worksheets("Indicateur UEC").Cells(10, j).Value = Worksheets("Indicateur UEC").Cells(10, j).Value + 1
         End If
        'idem pour les Oranges
        If Worksheets("chrono").Range("F" & i).Value = "O" Or Worksheets("chrono").Range("F" & i).Value = "o" Then
            Worksheets("Indicateur UEC").Cells(11, j).Value = Worksheets("Indicateur UEC").Cells(11, j).Value + 1
         End If
        'idem pour les rouges
        If Worksheets("chrono").Range("F" & i).Value = "R" Or Worksheets("chrono").Range("F" & i).Value = "r" Then
            Worksheets("Indicateur UEC").Cells(12, j).Value = Worksheets("Indicateur UEC").Cells(12, j).Value + 1
         End If
        'NC
        If Worksheets("chrono").Range("F" & i).Value = "NC" Or Worksheets("chrono").Range("F" & i).Value = "nc" Then
            Worksheets("Indicateur UEC").Cells(13, j).Value = Worksheets("Indicateur UEC").Cells(13, j).Value + 1
         End If
 
 
 
 
        GoTo ligne_suivante ' Si on a trouvé 1 résultat, on passe a la ligne suivante
 
 
 
        Next j
 
ligne_suivante:
    Next i
 
 
End Function

Cette macro comptabilise le nombre de couleur en fonction des dates et l'ajoute à la colonne correspondante, je n'arrive pas à traiter cette ligne 9.L'intégré à cette macro m'arrangerai.(ou non, en fonction de la faisabilité)
Est-il possible de l'adapter afin d'intégrer l'ajout de la ligne 9?

Ce que je ne comprends pas c'est comment je peux faire pour chaque mois en automatique. Je suis perdu lol ....

Je vous remercie de passer du temps sur mon problème.

Cordialement

Si tu n'as que des dates concernant janvier 2015 en colonne D :

Code:

1
2
3
4
5
Dim Plage As Range
With Sheets("chrono").AutoFilter
    Set Plage = Intersect(.AutoFilter.Range, .[D:D])
    Sheets("Indicateur UEC").[I9] = Application.Subtotal(103, Plage) - 1
End With

09/02/2015, 14h47
Mehdi8793

Dans cette colonne je trouve toutes les dates existantes, après cela dépend du filtre.

Je l'intégre à la fonction de l'ajout des couleurs? ou dans la feuille? Je suis débutant et je comprend pas tout.

cordialement
09/02/2015, 14h55
Mehdi8793

Ceci serais que pour jenvier dans le cas d'une automatisation pour tout les mois de l'année 2015, qu'elle est la meilleur solution?

Votre code génère l'erreur "Propriété ou méthode non généré par l'objet", il faut peut-etre que je l'adapte ?

Je suis navré de vous déranger et a la fois je vous remerçie du temps que vous passez à m'aider.

Cordialement

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
Public Function Fonction_Qui_Compte_Les_dates()
 
 
Dim dateChrono As Date
 
Dim derlign As Integer
 
derlign = Worksheets("chrono").Range("A10000").End(xlUp).Row ' on va chercher la derniere ligne utilisée de la colonne A
 
 'init des valeurs
        Worksheets("Indicateur UEC").Range("i9:t9") = ""
 
 
    For i = 48 To derlign 'on va parcourir du début de la colonne jusqu'à la dernière ligne identifiée
 
        For j = 9 To 20
 
 
 
        dateChrono = Worksheets("chrono").Range("D" & i).Value
        dateIndicateur = Worksheets("Indicateur UEC").Cells(8, j).Value
 
        If Month(dateChrono) = Month(dateIndicateur) Then 'On compare les mois
 
        Worksheets("Indicateur UEC").Cells(9, j).Value = Worksheets("Indicateur UEC").Cells(9, j).Value + 1
         End If
 
 
 
        GoTo ligne_suivante ' Si on a trouvé 1 résultat, on passe a la ligne suivante
 
 
 
        Next j
 
ligne_suivante:
    Next i
 
 
End Function

J'ai adapté celle des couleurs pour les dates vous pensais que cela est bon?

Cordialement

J'ai trouveé pour Janvier infiniment merci, et pour continuer sur les autres colonne février ect... La après janvier elle efface et elle stop. Voici la macro en question.

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
Public Function Fonction_Qui_Compte_Les_dates()
 
 
Dim dateChrono As Date
 
Dim derlign As Integer
 
derlign = Worksheets("chrono").Range("A10000").End(xlUp).Row ' on va chercher la derniere ligne utilisée de la colonne A
 
 'init des valeurs
        Worksheets("Indicateur UEC").Range("i9:t9") = ""
 
 
    For i = 37 To derlign 'on va parcourir du début de la colonne jusqu'à la dernière ligne identifiée
 
        For j = 9 To 20
 
 
 
        dateChrono = Worksheets("chrono").Range("D" & i).Value
        DateIndicateur = Worksheets("Indicateur UEC").Cells(8, j).Value
 
        If Month(dateChrono) = Month(DateIndicateur) Then 'On compare les mois
        'If Worksheets("chrono").Range("D" & i).Value = dateChrono And Worksheets("chrono").Range("D" & i).Value = DateIndicateur Then
        Worksheets("Indicateur UEC").Cells(9, j).Value = Worksheets("Indicateur UEC").Cells(9, j).Value + 1
         End If
 
        GoTo ligne_suivante ' Si on a trouvé 1 résultat, on passe a la ligne suivante
 
 
 
        Next j
 
ligne_suivante:
    Next i
 
 
End Function

Merci infiniment,

Cordialement

Après votre aide et d'avoir gratté j'ai trouver voici la macro si quelqu'un en un besoin:

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
Public Function Fonction_Qui_Compte_Les_dates()
 
 
Dim dateChrono As Date
 
Dim derlign As Integer
 
derlign = Worksheets("chrono").Range("A10000").End(xlUp).Row ' on va chercher la derniere ligne utilisée de la colonne A
 
 'init des valeurs
        Worksheets("Indicateur UEC").Range("i9:t9") = ""
 
 
    For i = 37 To derlign 'on va parcourir du début de la colonne jusqu'à la dernière ligne identifiée
 
        For j = 9 To 20
 
 
 
        dateChrono = Worksheets("chrono").Range("D" & i).Value
        DateIndicateur = Worksheets("Indicateur UEC").Cells(8, j).Value
 
        If Month(dateChrono) = Month(DateIndicateur) And Year(dateChrono) = Year(DateIndicateur) Then 'On compare les mois
        Worksheets("Indicateur UEC").Cells(9, j).Value = Worksheets("Indicateur UEC").Cells(9, j).Value + 1
 
 
        GoTo ligne_suivante ' Si on a trouvé 1 résultat, on passe a la ligne suivante
 
      End If
 
 
        Next j
 
ligne_suivante:
    Next i
 
 
End Function

Je vous remerçie pour votre aide Daniel !!!!! je le passe en résolu!!!!!!

Merci encore

Tu dois faire le compte des couleurs à part. J'ai créé une fonction qui calcule le nombre de jours. Pour janvier, tu mets :

Code:

=NbJours(I8)

en I9 et tirer la fonction vers la droite.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Function NbJours(Dat As Range) As Integer
    Dim Plage As Range, C As Range, Mois As Integer, An As Integer
    Application.Volatile
    With Sheets("chrono")
        Set Plage = Intersect(.AutoFilter.Range, .[D:D])
        Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1)
        If Application.Subtotal(103, Plage) > 0 Then
            Mois = Month(Dat)
            An = Year(Dat)
            For Each C In Plage
                If Month(C.Value) = Mois And Year(C.Value) = An Then
                    NbJours = NbJours + 1
                End If
            Next C
        End If
    End With
End Function