Petit souci avec des boucles.

[Neonours]

Bonjour tout le monde,

Je sais pas pourquoi, j'ai du mal à percuter les boucles et là, je m'en sors pas.

J'ai un fichier (voir PJ pour exemple) avec une page absence qui se rempli via un USF d'un autre classeur et qui calcul suivant la date et l'heure de départ et de retour le nombre de jours plein d'absence.

J'ai besoin d'une macro boucle qui va rechercher dans la feuille absence, pour chaque nom de la feuille récap et selon le mois sélectionner, le nombre total de jours d'absence du mois.

Mais, parce qu'il y a un mais, si l'absence est à cheval sur 2 mois (début dans le mois recherché et retour dans le mois suivant ou début dans le mois précédent et retour dans le mois sélectionné) il faut que la macro calcul depuis la date de départ jusqu'à la fin du mois ou depuis le début du mois jusqu'à la date de retour le nombre de jours entier d'absence.

Après moult recherche, j'ai pu sortir un peu de code si ça peut vous aider:

X=nom de personne
i=compteur

For Each Cell in Worksheet (Récap).Range("a2:a" & Woksheet.[a200].End (xlDown).Row)
 x = Cell.Value
Next Cell

Do While Cells (i,1).Value=""
 i=i+1
  For Each x in Worksheet (Absences).Range ("a2:a" & Worksheet.[a200].End (xlDown).Row)
   Function = sum ()
  Next x
Loop

Voilà, c'est un peu brouillon mais si ça peu vous aider.

Vous retrouverez toutes les données également sur la feuille Données de la PJ.

D'avance merci à celles et ceux qui se pencheront sur mon souci.

Neonour

 

[Dranreb]

Re : Petit souci avec des boucles.

Bonjour.
Je vous propose cette fonction personnalisé, à utiliser dans des cellules ou à invoquer dans un autre bout de code :

Option Explicit

Function TempsAbsenMois(ByVal Qui As String, ByVal Mois As Long, Année As Long, ByVal Plage As Range) As Double
Dim T(), L As Long, DébutPér As Date, FinPério As Date, Départ As Date, Retour As Date
DébutPér = DateSerial(Année, Mois, 1)
FinPério = DateSerial(Année, Mois + 1, 1)
T = Plage.Value
For L = 1 To UBound(T)
   If T(L, 1) = Qui Then
      Départ = T(L, 2) + T(L, 3): If T(L, 4) <> "" Then _
      Retour = T(L, 4) + T(L, 5) Else Retour = FinPério
      If Départ < DébutPér Then Départ = DébutPér Else If Départ > FinPério Then Départ = FinPério
      If Retour < DébutPér Then Retour = DébutPér Else If Retour > FinPério Then Retour = FinPério
      TempsAbsenMois = TempsAbsenMois + Retour - Départ
      End If
   Next L
End Function

Si par exemple on saisit Personne 1| 1| 2013 en A9:C9, en D9:

=TempsAbsenMois($A9;$B9;$C9;$A$2:$F$7)

Renvoie 22 00:45
Un retour non indiqué est interprété comme une absence ad vitam æternam, donc du nombre de jours de tous les mois spécifiés qui suivront celui de départ.
Persinne 1| 5| 2013 ==> 31 00:00

 

[Neonours]

Re : Petit souci avec des boucles.

Bonjour Dranreb,

D'abords, merci de te pencher sur mon souci!

J'essaie de comprendre ton code mais j'ai un peu de mal, j'apprends le mien au fur et à mesure de ce qu'on me demande de faire et jusque là, tous le forum m'a chaque fois appris énormément.

Juste quelques questions:

-Si la taille du tableau change, est ce que ça réajuste la plage de donnée automatiquement?

tu mets que:

Un retour non indiqué est interprété comme une absence ad vitam æternam, donc du nombre de jours de tous les mois spécifiés qui suivront celui de départ.

Pour le calcul, ça prend en compte de la date de départ jusqu'à la fin du mois ou est ce que ça prend un nombre jours aléatoire?

Encore merci.

Neonours

 

[Dranreb]

Re : Petit souci avec des boucles.

La plage de données est à spécifier en 4ème paramètre de la fonction, elle se contente de l'appliquer.
Vous pourrez vous arranger facilement, avec votre version d'Excel pour veiller à ce qu'elles soit de la bonne taille, si vous l'avez par exemple convertie en tableau, que ce soit en formule ou si vous l'utilisez dans du code. Dans ce dernier cas vous auriez peut être intérêt à extraire le tableau T en dehors de la fonction, et passer plutôt celui ci en paramètre 4, (T(), plutôt que la plage, ByVal Plage As Range, et vous enlevez la déclaration de T() et son affectation plus bas.

Si la date de départ est dans le mois demandé en 2ème et 3ème paramètre, ça rendra évidemment la durée en jours depuis la date de départ jusqu'à la fin du mois. Si elle en est antérieure au mois demandé elle rendra le nombre de jours de ce mois. Une date de retour non spécifiée est en somme assimilée à une date indéterminée, loin dans l'avenir.

 

[Neonours]

Re : Petit souci avec des boucles.

Un grand merci pour ces explications, je continuerai à étudier ce code demain.

Bonne soirée et bonne nuit.

Neonours

 

[Neonours]

Re : Petit souci avec des boucles.

Bonjour,

Dranreb, je n'ai pas vraiment compris ton code mais je m'en suis un peu inspirer pour taper le mien.

Petit soucis, maintenant, il me sort une erreur d'exécution '7': mémoire insuffisante

Je n'arrive pas à trouver un moyen pour pallier à cette erreur (je cherche depuis ce matin).

Voici le code que j'ai tapé:

Option Explicit

Private Sub Maj_Abs()
'définition des variables
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim debmois As Date
Dim finmois As Date
Dim mois As Long
Dim annee As Long
Dim x As Variant
Dim i As Variant
Dim s As Integer
Dim y As Variant
Dim c As Variant
'définition des références de variable
Set ws1 = Sheets("Récapitulatif")
Set ws2 = Sheets("Absences")
debmois = DateSerial(annee, mois, 1)
finmois = DateSerial(annee, mois + 1, 1)
'boucle de recherche
For Each c In ws1.Range("a2:a" & ws1.[a200].End(xlDown).Row)
 x = Cells.Value
  Do While Cells(i, 1).Value = ""
   i = i + 1
    For Each x In ws2.Range("a2:a" & ws2.[a200].End(xlDown).Row)
     If Cells(i, 8).Value = ws1.Cells(1, 6).Value And Cells(i, 9).Value = ws1.Cells(1, 6).Value Then
      s = s + Cells(i, 10).Value
       ElseIf Cells(i, 8).Value = ws1.Cells(1, 6).Value And Cells(i, 9).Value <> ws1.Cells(1, 6).Value Then
        y = WorksheetFunction.Int(finmois - (Cells(i, 3).Value + Cells(i, 4).Value))
        s = s + y
         ElseIf Cells(i, 8).Value <> ws1.Cells(1, 6).Value And Cells(i, 9) = ws1.Cells(1, 6).Value Then
          y = WorksheetFunction.Int(debmois - (Cells(i, 5).Value + Cells(i, 6).Value))
          s = s + y
     End If
     Cells.Range(x, 3).Value = s
    Next x
  Loop
Next c
End Sub

D'avance merci.

Neonours

 

[Dranreb]

Re : Petit souci avec des boucles.

Bonjour.
Alors vous quand vous ne comprenez pas un code qui marche vous préférer en réécrire un qui ne marche pas !

P.S. Et bien moi je vous ai tout réécrit aussi et quand même. Dans le module FRécap (Récap)
Plus de bouton. Ça se recalcule en activant la feuille ou en changeant le mois.

 

[Neonours]

Re : Petit souci avec des boucles.

Bonjour Dranreb,

Mon intention n'était absolument pas de dénigrer ce que vous avez fait mais je suis OBLIGE de comprendre les code car je dois les expliquer à la responsable informatique de ma boîte (qui y pige pas une broc). Donc, quand je ne comprend pas un code, j'essaye d'en taper un que je peux comprendre.

De plus, je n'ai pas une mais 3 feuilles qui doivent être calculée de cette manière et si je ne comprend pas, je ne pourrais pas adapter ce code pour les autres feuilles.

Néanmoins, je vous remercie pour ce code et si, par le plus grand des hasard, vous connaissiez une façon de "contourner" ou de corriger le code pour éviter l'erreur dont j'ai fait part plus haut, je vous en serais reconnaissant. Au mieux, ça fera pour ma culture générale et je saurais si jamais je m'y trouve à nouveau confronté.

Encore merci.

Neonours

 

[Dranreb]

Re : Petit souci avec des boucles.

Bonjour.
Il fallait plutôt me demander de re-joindre le classeur muni de commentaires explicatifs.
Manifestement vous ne comprenez pas même ce que vous écrivez vous même.

x = Cells.Value

tente de charger en mémoire les valeurs de l'intégralité de la feuille active dans un tableau à 2 dimensions du maximum de lignes et de colonnes possibles.
Et ça pour rien: vous ne vous en servez même pas puisque vous utilisez cette variable x à un autre usage 3 lignes plus bas. Évitez quand c'est possible le type Variant.

 

[Neonours]

Re : Petit souci avec des boucles.

Rebonjour,

il est vrai que j'aurais pu et dû vous demandez quelques commentaire explicatif. Malgré moi, certaines choses assez "basique" m'échappe parfois comme de demander les explications et je m'en excuse sincèrement.

Je me suis doutez que le "x=Cells.Value" tentais de charger trop de données en faisant un pas à pas (auquel je n'avais pas pensé avant ce matin).

Effectivement, je ne comprend pas forcément la totalité du code que je tape mais c'est en faisant de la sorte que j'en apprend le plus. J'essaie également d'utiliser au minimum le type Variant mais parfois, je ne vois pas vraiment quoi mettre d'autre.

Si cela est encore possible, je ne suis pas contre quelques commentaires dans votre dernier code.

D'avance merci.

Neonours

 

[Dranreb]

Re : Petit souci avec des boucles.

Voilà le code commenté.

Et pour pallier à votre doute quand aux types à appliquer aux variable, je vous propose cette procédure CommentDéclarer, à utiliser en phase de mise au point dans vos programmes :

Sub Essai()
Dim W, X, Y, Z
CommentDéclarer "W", W
For Each X In Worksheets(1).[A1:A3]
   CommentDéclarer "X", X
   Exit For
   Next X
Y = Worksheets(1).Rows.Count
CommentDéclarer "Y", Y
Z = Worksheets(1).[A1:A10].Value
CommentDéclarer "Z", Z
End Sub

Sub CommentDéclarer(ByVal NomVar As String, ByVal X As Variant)
Dim TypDon As String, P As Long
TypDon = TypeName(X)
If TypDon = "Empty" Or TypDon = "Null" Then
   MsgBox NomVar & " n'est pas correctement initialisé" & vbLf & "de sorte que la façon de le" & vbLf & "déclarer ne peut être déterminée."
Else
   P = InStr(TypDon & "()", "()")
   MsgBox "Pour de meilleures performances," & vbLf & "sous toutes réserves :" & vbLf & "Dim " & NomVar & _
      Mid$(TypDon, P) & " As " & Left$(TypDon, P - 1)
   End If
End Sub

 

[Neonours]

Re : Petit souci avec des boucles.

Merci beaucoup, je vais étudié tout cela très attentivement et je vous ferais un retour mais vu que c'est bientôt l'heure de rentrer à la maison, le retour ne sera pas avant demain.

En attendant, je vous souhaite une bonne soirée.

Neonours