Adapter une macro de calcul

bonjour,

je sollicite de l'aide pour adapter la macro "calcul" dans le fichier joint qui permet de faire la somme des heures et des repas semaine par semaine.

Mes compétences ont des limites et la je suis incapable de l'adapter, merci de votre aide.

Dianmelo

Personne pour m'aider SVP ?

bonsoir,

1à personnes qui ont téléchargé le classeur et pas une réponse : C'est aussi nébuleux pour les autres que pour moi.

Comment ta macro elle sait ou vont les semaines 9,13, 22 ou 26 ? ... ça serait reporter des mois entiers : facile, mais des semaines à cheval sur plusieurs mois ça ne peux se faire que si on connaît la règle de répartition des semaines / mois...

En pratique on considère souvent que toute semaine commencé le mois N se termine le même mois

Avec cette règle le mois de Février 2016 va du 1er février au 6 Mars : 5 semaines

et le mois de Mars commence le 7 Mars (semaine 10)

Toujours avec cette règle, les mois de Mai, Aout et Octobre comportent également 5 semaines. C'est ça ?

A+

Merci de ta réponse galopin01

j'ai avancé un peu, le fichier joint fonctionne très bien pour 6 utilisateurs jusqu’à la colonne p.

C'est après que ça se complique

Ajoutes des semaines sur plusieurs mois et tu verras que les calculs sont bons.

Cordialement

Bonsoir,

Si tu pouvais répondre à mes questions ce serait bien !

Puis-je avoir les 5 premières semaines pour tester les cumuls.

A+

Il te suffit de cliquer sur ajout semaine pour ajouter autant de semaines que tu veux, ensuite sur calcul pour faire les totaux..

Bonsoir,

La macro KIVABIEN :

Option Base 1
Sub Calcul()
Dim x%, i%, k%, iR%, iC%, iQ% 'test As Integer
Dim TTHQ(2, 12)

Dim WsS As Worksheet
mois = 1
For x = 1 To Worksheets.Count - 1
    Set WsS = Worksheets("Semaine " & x) 'choix onglet
    If mois < Month(WsS.[A7]) Then 'Ecriture
      For i = 1 To 12
         Worksheets("Accueil").Cells(i + 2, mois + 1) = TTHQ(1, i)      'Repas
         Worksheets("Accueil").Cells(i + 17, mois + 1) = TTHQ(2, i)     'Heures
      Next
      Erase TTHQ
      mois = mois + 1
    End If
      For iR = 12 To 32 Step 10
         For iC = 6 To 30 Step 8
           iQ = iQ + 1
           TTHQ(2, iQ) = TTHQ(2, iQ) + WsS.Cells(iR, iC).Value       'Heures
           TTHQ(1, iQ) = TTHQ(1, iQ) + WsS.Cells(iR, iC + 1).Value   'repas
        Next
      Next
      iQ = 0
Next
   For i = 1 To 12 'Ecriture du dernier mois
      Worksheets("Accueil").Cells(i + 2, mois + 1) = TTHQ(1, i)         'Repas
      Worksheets("Accueil").Cells(i + 17, mois + 1) = TTHQ(2, i)        'Heures
   Next
End Sub

A+

Je te remercie galopin01

après un test rapide, il me semble que contrairement à la macro d'origine, les totaux se font par semaine entière et non pas par jour.

Exemple, la semaine 9 est entièrement comptabilisé avec février, alors qu'elle ne contient qu'une journée de février le 29/02.

En tout cas merci, je vais voir comment arranger ça demain.

Bonne soirée

Si tu avais répondu à ma première question, ça ne serait pas arrivé....

En fait les semaines tu t'en fout ce que tu veux c'est récupérer les chiffres de chaque mois...

Je vais y réfléchir.

A+

bonsoir,

La macro corrigée...

Option Base 1
Sub Calcul()
Dim x%, i%, iA%, k%, iR%, iC%, iQ%
Dim TTHQ(2, 12)
Dim Arr
Dim WsS As Worksheet, WsC As Worksheet
Set WsC = Worksheets("Accueil")
'Définir les lignes de dates analogues (mod 3)
Arr = Split("7 17 27 8 18 28 9 19 29 10 20 30 11 21 31")
mois = 1
For x = 1 To Worksheets.Count - 1
    Set WsS = Worksheets("Semaine " & x) 'choix onglet
      For iA = 0 To 14
      If iA Mod 3 = 0 Then iQ = 0 'Init l'utilisateur chaque jour
         iR = Arr(iA)
         If mois < Month(WsS.Cells(iR, 1)) Then 'Ecriture
           For i = 1 To 12
              WsC.Cells(i + 2, mois + 1) = TTHQ(1, i)      'Repas
              WsC.Cells(i + 17, mois + 1) = TTHQ(2, i)     'Heures
           Next
           Erase TTHQ
           mois = mois + 1
         End If
         For iC = 6 To 30 Step 8
            iQ = iQ + 1
           TTHQ(2, iQ) = TTHQ(2, iQ) + WsS.Cells(iR, iC).Value       'Heures
           TTHQ(1, iQ) = TTHQ(1, iQ) + WsS.Cells(iR, iC + 1).Value   'repas
         Next
      Next
Next
   For i = 1 To 12 'Ecriture du dernier mois
      WsC.Cells(i + 2, mois + 1) = TTHQ(1, i)         'Repas
      WsC.Cells(i + 17, mois + 1) = TTHQ(2, i)        'Heures
   Next
End Sub

A+

Merci, c'est parfait.

désolé pour le malentendu, je pensais qu'il était simple d'adapter la macro existante et je n'ai été assez attentif.

Bonne journée à toi