Sujet Précédent Sujet Suivant

Incrementer la taille d un tableau automatiquement->Des Dates

Résolu/Fermé
hajars - 26 juil. 2016 à 09:37
thev Messages postés 1882 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 26 octobre 2024 - 11 août 2016 à 19:43
Bonjour,

Bonjouur les VBAistes
J aurai besoin de votre aide svp pour un probleme qui me fait chier depuis quelques jours
Je souhaite réaliser un tableau ou la 1ere colonne c est des dates(ex 2015/2016) la deuxieme y a un titre (AVERAGE DELAY BETWEEN iNTEGRATION AND REQUEST) et la 3eme colonne c est la moyenne de jours entre octobre2015 et janvier 2016 la 6eme entre fevrier 2016 et mai 2016 et la derniere juin 2016 septembre 2016
j essayerai de vous mettre une photo le plus tot possible

En effet, je veux calculer le nbre de jours entre deux dates la colonne Q et G qui sont sur une feuille "All" et realiser la moyenne et la mettre dans le tableau joint.
Si le mois de la colonne G est 1/2016 10/2015 11/2015 12/2015 je veux faire la moyenne et l affecter et la cellule B2 du tableau joint
si c est 2/2016 3/2016 4/2016 ca sera affecte a C2 et 5/2016 6/2016 7/2016 8/2016 dans la colonne D2 du tableau joint toujours
ça j ai reussi a le faire avec le code suivant sachant que je n avais a calculer que la moyenne de l annee 2015 2016 

Sub IsoIndicators()

Dim rcell As Range

Dim somme1 As Integer
Dim somme2 As Integer
Dim somme3 As Integer
Dim nbupdates1 As Integer
Dim nbupdates2 As Integer
Dim nbupdates3 As Integer
somme1 = 0
nbupdates1 = 0
somme2 = 0
nbupdates2 = 0
somme3 = 0
nbupdates3 = 0
lastlign = Worksheets("All").Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lastlign
If (IsDate(Worksheets("All").Range("Q" & i)) And IsDate(Worksheets("All").Range("G" & i))) Then

Worksheets("All").Range("Z" & i) = dateDiff("d", Worksheets("All").Range("G" & i), Worksheets("All").Range("Q" & i))
Else
Worksheets("All").Range("Z" & i) = ""
End If

Next
For i = 2 To lastlign
If (Worksheets("All").Range("Z" & i) <> "") Then

If (Year(Worksheets("All").Range("Q" & i).Value) = 2016 And Month(Worksheets("All").Range("Q" & i).Value) = 2) Or ((Year(Worksheets("All").Range("Q" & i).Value) = 2016 And Month(Worksheets("All").Range("Q" & i).Value) = 3)) Or ((Year(Worksheets("All").Range("Q" & i).Value) = 2016 And Month(Worksheets("All").Range("Q" & i).Value) = 4)) Or ((Year(Worksheets("All").Range("Q" & i).Value) = 2016 And Month(Worksheets("All").Range("Q" & i).Value) = 5)) Then
somme1 = somme1 + Worksheets("All").Range("Z" & i)
nbupdates1 = nbupdates1 + 1
ElseIf (Year(Worksheets("All").Range("Q" & i).Value) = 2015 And Month(Worksheets("All").Range("Q" & i).Value) = 10) Or ((Year(Worksheets("All").Range("Q" & i).Value) = 2015 And Month(Worksheets("All").Range("Q" & i).Value) = 11)) Or ((Year(Worksheets("All").Range("Q" & i).Value) = 2015 And Month(Worksheets("All").Range("Q" & i).Value) = 12)) Or ((Year(Worksheets("All").Range("Q" & i).Value) = 2016 And Month(Worksheets("All").Range("Q" & i).Value) = 1)) Then
somme2 = somme2 + Worksheets("All").Range("Z" & i)
nbupdates2 = nbupdates2 + 1
ElseIf (Year(Worksheets("All").Range("Q" & i).Value) = 2016 And Month(Worksheets("All").Range("Q" & i).Value) = 6) Or ((Year(Worksheets("All").Range("Q" & i).Value) = 2016 And Month(Worksheets("All").Range("Q" & i).Value) = 7)) Or ((Year(Worksheets("All").Range("Q" & i).Value) = 2016 And Month(Worksheets("All").Range("Q" & i).Value) = 8)) Or ((Year(Worksheets("All").Range("Q" & i).Value) = 2016 And Month(Worksheets("All").Range("Q" & i).Value) = 9)) Then
somme3 = somme3 + Worksheets("All").Range("Z" & i)
nbupdates3 = nbupdates3 + 1

End If
End If
Next
Worksheets("Iso Indicators").Range("C2") = somme1 / nbupdates1
Worksheets("Iso Indicators").Range("B2") = somme2 / nbupdates2
Worksheets("Iso Indicators").Range("D2") = somme3 / nbupdates3

End Sub



Mnt on me demande de parametrer le tableau pour que ça prenne toutes les années qui sont sur une colonne Q de la feuille All
C est a dire qu on saisira l annee prochaine une date 2017 me tableau doit se mettre a jour automatiqueemnt et rajouter une ligne 2016/2017 en dessous de 2015/2016

je vous mettrai en PJ une capture du tableau d ou j extrais les donnees
la colonne Q c est Date Update Integration et la colonne G c est Date Update Request; c est a partir de ces deux colonnes que je calcule la moyenne
Please Helpez moi si vous avez d idées je suis coincée
Merci beaucoup

9 réponses

Réponse 1 / 9
thev Messages postés 1882 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 26 octobre 2024 690
Modifié par thev le 26/07/2016 à 14:05
Bonjour,

Pour régler ton problème, il suffit d'ajouter une fonction période adaptée aux quadrimestres demandés.
ci-dessous code amélioré + fonction période 

Sub IsoIndicators()
    
    Dim ligne As Range
    Dim somme1 As Integer, somme2 As Integer, somme3 As Integer
    Dim nbupdates1 As Integer, nbupdates2 As Integer, nbupdates3 As Integer
    
    somme1 = 0
    nbupdates1 = 0
    somme2 = 0
    nbupdates2 = 0
    somme3 = 0
    nbupdates3 = 0
        
    With Worksheets("All").UsedRange    'plage utilisée de la feuille
        
        For Each ligne In .Offset(1).Resize(.Rows.Count - 1).Rows     'lignes utilisées à partir de la 2ème
            If IsDate(ligne.Columns("Q")) And IsDate(ligne.Columns("G")) Then
                ligne.Columns("Z") = DateDiff("d", ligne.Columns("G"), ligne.Columns("Q"))
            Else
                ligne.Columns("Z") = ""
            End If
        
            If ligne.Columns("Z") <> "" Then
                If période(ligne.Columns("Q")) = 1 Then somme1 = somme1 + ligne.Columns("Z"):   nbupdates1 = nbupdates1 + 1
                If période(ligne.Columns("Q")) = 2 Then somme2 = somme2 + ligne.Columns("Z"):   nbupdates2 = nbupdates2 + 1
                If période(ligne.Columns("Q")) = 3 Then somme3 = somme3 + ligne.Columns("Z"):   nbupdates3 = nbupdates3 + 1
            End If
            
        Next ligne
        
    End With
        
    With Worksheets("Iso Indicators")
        .Range("C2") = somme1 / nbupdates1
        .Range("B2") = somme2 / nbupdates2
        .Range("D2") = somme3 / nbupdates3
    End With

End Sub

Function période(ByVal date_i As Date)

    Dim mois_périodes()
    Dim recherche_mois As String, mois_période As String
    
    mois_périodes = Array("1/2", "2/1", "3/1", "4/1", "5/1", "6/3", "7/3", "8/3", "9/3", "10/2", "11/2", "12/2")
    recherche_mois = DatePart("M", date_i) & "/"
    mois_période = Filter(mois_périodes, recherche_mois)(0)
    période = Split(mois_période, "/")(1)

End Function
--
 
1
Réponse 2 / 9
thev Messages postés 1882 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 26 octobre 2024 690
26 juil. 2016 à 17:32
Il me semble que ton tableau de la feuille "Iso Indicators" devrait plutôt être celui-ci


La fonction période représente le quadrimestre et permet le placement dans la colonne du tableau mais pas au niveau de la ligne (2015-2016, 2016-2017,..). Le plus simple me parait être de créer une deuxième fonction permettant le placement au niveau de la ligne.
1
Réponse 3 / 9
thev Messages postés 1882 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 26 octobre 2024 690
26 juil. 2016 à 22:25
Bonsoir,

L'ancienne fonction période a été renommée en fonction quadrimestre. Une nouvelle fonction période a été ajoutée (2015-2016, 2016-2017,..).

ci-dessous nouveau code nécessitant l'ajout de la référence Microsoft Scripting Runtime 

'ajouter référence Microsoft Scripting Runtime
Sub IsoIndicators()
    
    Dim ligne As Range
    Dim délais_Iso As New Dictionary, comptages_Iso As New Dictionary
    Dim nb_quadrimestres As Integer
    nb_quadrimestres = 3
    Dim délais(3), comptages(3), tableau()
    Dim nb_jours As Integer
    Dim délai As Variant
    Dim q As Integer, p As Variant
    
    'stockage délais et comptages par période et quadrimestre  ..........................................................
    With Worksheets("All").UsedRange    'plage utilisée de la feuille
        
        For Each ligne In .Offset(1).Resize(.Rows.Count - 1).Rows     'lignes utilisées à partir de la 2ème
            
            If IsDate(ligne.Columns("Q")) And IsDate(ligne.Columns("G")) Then
                'période et quadrimestre
                p = période(ligne.Columns("Q"))
                q = quadrimestre(ligne.Columns("Q"))
                
                'comptages_Iso
                If comptages_Iso.Exists(p) Then
                    tableau = comptages_Iso(p)
                    tableau(q - 1) = tableau(q - 1) + 1
                    comptages_Iso(p) = tableau
                Else
                    comptages(q - 1) = 1
                    comptages_Iso.Add Key:=p, Item:=comptages
                End If
               
                'délais_Iso
                nb_jours = DateDiff("d", ligne.Columns("G"), ligne.Columns("Q"))
                If délais_Iso.Exists(p) Then
                    tableau = délais_Iso(p)
                    tableau(q - 1) = tableau(q - 1) + nb_jours
                    délais_Iso(p) = tableau
                Else
                    délais(q - 1) = nb_jours
                    délais_Iso.Add Key:=p, Item:=délais
                End If
            End If
            
        Next ligne
        
    End With
   
    
    'calcul délais moyens par période et quadrimestre  ..........................................................
    For Each p In délais_Iso.Keys
        tableau = délais_Iso(p)
        For i = 0 To UBound(tableau)
            If tableau(i) <> Empty Then tableau(i) = tableau(i) / comptages_Iso(p)(i)
        Next i
        délais_Iso(p) = tableau
    Next p
  
    
    'affichage résultat dans la feuille "Iso Indicators"
    Set xl = Application
    With Worksheets("Iso Indicators")
        .Range("A2").Resize(délais_Iso.Count) = xl.Transpose(délais_Iso.Keys)
        .Range("B2").Resize(délais_Iso.Count, 3) = xl.Transpose(xl.Transpose(délais_Iso.Items))
    End With

End Sub

Function période(ByVal date_i As Date) As String

    Dim quadrimestre_i As Integer
    
    quadrimestre_i = quadrimestre(date_i)
    If quadrimestre_i = 1 Then année = Year(DateAdd("m", 4, date_i)) _
    Else année = Year(date_i)
    période = année - 1 & "/" & année

End Function

Function quadrimestre(ByVal date_i As Date) As Integer

    Dim mois_quadrimestres()
    Dim recherche_mois As String, mois_quadrimestre As String
    
    mois_quadrimestres = Array("1/1", "2/2", "3/2", "4/2", "5/2", "6/3", "7/3", "8/3", "9/3", "10/1", "11/1", "12/1")
    recherche_mois = DatePart("M", date_i) & "/"
    mois_quadrimestre = Filter(mois_quadrimestres, recherche_mois)(0)
    quadrimestre = Split(mois_quadrimestre, "/")(1)

End Function

 
1
Réponse 4 / 9
hajars Messages postés 32 Date d'inscription mardi 26 juillet 2016 Statut Membre Dernière intervention 20 septembre 2016
26 juil. 2016 à 16:23
Merci pour ta reponse c'est effective,ent une version avancée du code mais ça alourdit le code un peu Est ce que c est notmal
Par contre meme avec la fonction periode mon probleme n est pas resolu, Voila un aperçu du tableau que j'ai et je souhaite qu une fois une nouvelle date est saisie en Q qu elle soit integrée au tableau c est a dire si je saisis 2017 je veux avoir en dessous de 2015/2016 2016/2017 et puis realiser les memes operations pou les mois..
'Peut etre parce que je suis debutante je n ai pas su mettre en place votre fonction

merci encore une fois bcp
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 9
hajars Messages postés 32 Date d'inscription mardi 26 juillet 2016 Statut Membre Dernière intervention 20 septembre 2016
28 juil. 2016 à 14:30
'Bonjour
'D abord desolee pour cette reponse tardive mais c est parce que j etais pas au bureau Merci beaucoup pour le temps que t as consacré pour m'aider avec mon probmème j aurai jamais penser à un code pareil
'Le code est un peu voire très avancé par rapport à mon niveau en vba j'ai regardé la syntaxe de la fonction dateAss mais je comprends toujours pas pourquoi t as mis 4 sur la fonction DateAdd("m",4,date_i)
'Voici un capture d ecran du tableau que j ai obtenu. Y a quelques soucis Le 1er, j'ai des valeurs abberrantes 552.Aussi je dois avoir un resultat pour la periode 2014/2015 Mois 10-1 parcce que j ai des dates sur mon tableau mais rien ne s affiche
'Quand j ajoute l annee 2018 j ai comme resultat le tableau ci joint
'J aimerai aussi que les dates que j ai soient triés c est a dire que j ai 2014/2015 puis 2015/2016 en dessous ainsi de suite
'J arrive pas trop a faire ces modifications sur ton code parce que je me renseigne toujours sur les dictionnaires j ai jamais utilisé ça

De tte façon Merci bcp pr ton aide



0
Réponse 6 / 9
thev Messages postés 1882 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 26 octobre 2024 690
28 juil. 2016 à 21:25
1) DateAdd("m",4,date_i) pourquoi 4 parce c'est la durée du quadrimestre, mais j'aurais pu réduire à 3, le but étant que octobre, novembre et décembre passent sur l'année suivante

2) les résultats aberrants sont a priori dus à la non prise en compte des compteurs correspondants. il faudrait que tu me communiques le contenu de tes colonnes Q et G pour voir où se situe l'anomalie car j'en ai pas décelé avec mon jeu de test.

3) je regarde pour le tri des périodes.
0
Réponse 7 / 9
thev Messages postés 1882 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 26 octobre 2024 690
Modifié par thev le 29/07/2016 à 01:15
Bonsoir,

Je pense avoir résolu l'anomalie des résultats aberrants.
ci-joint code corrigé avec mise en place du tri des périodes 



'ajouter référence Microsoft Scripting Runtime
Sub IsoIndicators()
    
    Dim ligne As Range
    Dim délais_Iso As New Dictionary
    Set nb_jours_Iso = CreateObject("System.Collections.Sortedlist")
    Set comptages_Iso = CreateObject("System.Collections.Sortedlist")
    Dim tableau(), tableau_init()
    tableau_init = Array(0, 0, 0)
    Dim nb_jours As Integer
    Dim délai As Variant
    Dim q As Integer, p As String, i1 As Integer, i2 As Integer
    
    'stockage jours et comptages par période et quadrimestre  ..........................................................
    With Worksheets("All").UsedRange    'plage utilisée de la feuille
        
        For Each ligne In .Offset(1).Resize(.Rows.Count - 1).Rows     'lignes utilisées à partir de la 2ème
            
            If IsDate(ligne.Columns("Q")) And IsDate(ligne.Columns("G")) Then
                'période et quadrimestre
                p = période(ligne.Columns("Q"))
                q = quadrimestre(ligne.Columns("Q"))
               
                'stockage jours par période et quadrimestre dans la première collection Sortedlist "nb_jours_Iso"
                nb_jours = DateDiff("d", ligne.Columns("G"), ligne.Columns("Q"))
                If nb_jours_Iso.ContainsKey(p) Then
                    tableau = nb_jours_Iso(p)
                    tableau(q - 1) = tableau(q - 1) + nb_jours
                    nb_jours_Iso(p) = tableau
                Else
                    tableau = tableau_init
                    tableau(q - 1) = nb_jours
                    nb_jours_Iso.Add (p), tableau
                End If
                
                'stockage comptages par période et quadrimestre dans la deuxième collection Sortedlist "comptages_Iso" associée à la précédente
                If comptages_Iso.ContainsKey(p) Then
                    tableau = comptages_Iso(p)
                    tableau(q - 1) = tableau(q - 1) + 1
                    comptages_Iso(p) = tableau
                Else
                    tableau = tableau_init
                    tableau(q - 1) = 1
                    comptages_Iso.Add p, tableau
                End If
            End If
            
        Next ligne
        
    End With
   
    'calcul et stockage délais par période et quadrimestre  dans le dictionnaire délais_Iso ................................
    For i1 = 0 To nb_jours_Iso.Count - 1
        clé = nb_jours_Iso.GetKey(i1)
        tableau = nb_jours_Iso(clé)
        For i2 = 0 To UBound(tableau)
            If tableau(i2) <> Empty Then tableau(i2) = tableau(i2) / comptages_Iso(clé)(i2)
        Next i2
        délais_Iso.Add Key:=clé, Item:=tableau
    Next i1
  
    'affichage résultat dans la feuille "Iso Indicators"
    Set xl = Application
    With Worksheets("Iso Indicators")
        .Range("A2").Resize(délais_Iso.Count) = xl.Transpose(délais_Iso.Keys)
        .Range("B2").Resize(délais_Iso.Count, 3) = xl.Transpose(xl.Transpose(délais_Iso.Items))
    End With

End Sub

Function période(ByVal date_i As Date) As String

    Dim quadrimestre_i As Integer
    
    quadrimestre_i = quadrimestre(date_i)
    If quadrimestre_i = 1 Then année = Year(DateAdd("m", 4, date_i)) _
    Else année = Year(date_i)
    période = année - 1 & "/" & année

End Function

Function quadrimestre(ByVal date_i As Date) As Integer

    Dim mois_quadrimestres()
    Dim recherche_mois As String, mois_quadrimestre As String
    
    mois_quadrimestres = Array("1/1", "2/2", "3/2", "4/2", "5/2", "6/3", "7/3", "8/3", "9/3", "10/1", "11/1", "12/1")
    recherche_mois = DatePart("M", date_i) & "/"
    mois_quadrimestre = Filter(mois_quadrimestres, recherche_mois)(0)
    quadrimestre = Split(mois_quadrimestre, "/")(1)

End Function




 
0
Réponse 8 / 9
hajars Messages postés 32 Date d'inscription mardi 26 juillet 2016 Statut Membre Dernière intervention 20 septembre 2016
10 août 2016 à 10:01
'JE T'ai deja ecrit un message pour te remercier mais soit ça a été supprimé soit ma connexion est plus merdique que ce que je croyais
'Enfin Bref Merci beaucoup beaucoup pour ton aide ton temps et tes explications
0
Réponse 9 / 9
thev Messages postés 1882 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 26 octobre 2024 690
11 août 2016 à 19:43
Bien. N'oublie pas de mettre le sujet en résolu.
0

Discussions similaires

À quoi correspond 32x32 US en taille française pour un jean ?
Alison1958 -
Thordendall -

1 réponse
W32 L32: correspondance entre taille US et taille française
efg -
sibel -

6 réponses
ou sont les bananes ?
Liline -
Le Pro -

2 réponses
exo pix
Xtyller -
Raymond PENTIER -

2 réponses
Tableau croisé dynamique - absence de certaines données
crazyrider71 -
Hana -

4 réponses