Bonjour ,
je suis toujours bloqué sur la macro pour ajouter un (voir des ) tableaux supplémentaires .
J’ai modifié comme initialement indiqué mais je pense qu’une autre modification est necessaire pour que les données du dernier tableau ajouté soient recopiées dans mon cumul :
Sub M_Cumul()
Dim LO, LO_Cum, LO_ds, LO_Rep, LO_Suppl, LO_Transfert2, LO_CHSCT, aTansfert, aMois, aReport, i, j, aHistoire() As Double, Mois0, Mois_Prec, aM1, sNom, X() As Integer, aOut, Solde, Trop, bZero, aValeurs, Dict
Set Dict = CreateObject("scripting.dictionary")
Dim iSCE_Max: iCSE_Max = 37.5 'max cumulé
Dim iSCE_: iCSE_ = 25 'heures par semaine
For Each LO In Sheets("synthese").ListObjects
LO.Range.AutoFilter 1
LO.Range.AutoFilter
Next
Set LO_ds = Range("tbl_ds").ListObject
Set LO_Rep = Range("tbl_Report").ListObject
Set LO_Suppl = Range("tbl_Supplementaires").ListObject
Set LO_Transfert2 = Range("tbl_Transferts2").ListObject
Set LO_CHSCT = Range("tbl_CHSCT").ListObject
Set LO_Cum = Range("tbl_Cumul").ListObject
LO_Cum.DataBodyRange.Offset(, 1).ClearContents
' ********************** pour la simplicité, tous ces tableaux ont les ùêmes entêtes et les mêmes titulaires dans la même séquence
arr = Array("tbl_report", "tbl_transferts2", "tbl_Supplementaires", "tbl_CHSCT", "tbl_Cumul", "tbl_ds")
ReDim aValeurs(0 To UBound(arr))
With LO_Rep
aMois = .HeaderRowRange.Value
sHeader = Join(Application.Transpose(Application.Transpose(.HeaderRowRange.Value)), "|")
sNoms = Join(Application.Transpose(.ListColumns("Titulaire").DataBodyRange.Value), "|")
End With
For i = 0 To UBound(arr)
With Range(arr(i)).ListObject
If sHeader <> Join(Application.Transpose(Application.Transpose(.HeaderRowRange.Value)), "|") Then MsgBox "Entêtes ne correspondent pas avec les autres tableaux", vbCritical, "TABLEAU : " & Chr(34) & s & Chr(34): Exit Sub
If sNoms <> Join(Application.Transpose(.ListColumns("Titulaire").DataBodyRange.Value), "|") Then MsgBox "Titulaires ne correspondent pas avec les autres tableaux", vbCritical, "TABLEAU : " & Chr(34) & s & Chr(34): Exit Sub
End With
Next
Application.ScreenUpdating = False
Application.EnableEvents = False
With LO_Rep
For i = 1 To .ListRows.Count
ReDim aHistoire(1 To 12) 'nouveau nom = RAZ aHistoire
sNom = .DataBodyRange.Cells(i, 1).Value
For j = 2 To .ListColumns.Count 'boucler les mois
'******************decaler les données historique d'un mois **********
For j1 = UBound(aHistoire) To 2 Step -1
aHistoire(j1) = aHistoire(j1 - 1)
Next
aHistoire(1) = 0 'RAZ données pour ce mois
'******************recuperer les 5 types d'heures **************
For k = 0 To UBound(arr)
aValeurs(k) = Range(arr(k)).ListObject.DataBodyRange.Cells(i, j).Value 'lire le contenu des 5 tableaux pour ce titulaire & mois
Next
'******************soustraire les heures utilisées des données historique **********
temp0 = 0
temp1 = 0
If aValeurs(0) > 0 Then 'on a utilisé des heures ce mois
temp0 = aValeurs(0) 'les heures utilisées qu'on soustraira des heures historiques
temp1 = iCSE_ - temp0 'les heures qu'on n'a pas utilisé qu'on ajoutera aux heures historiques
For j1 = UBound(aHistoire) To 2 Step -1
temp2 = Application.Max(0, Application.Min(aHistoire(j1), temp0))
aHistoire(j1) = aHistoire(j1) - temp2
temp0 = temp0 - temp2
If temp0 <= 0 Then Exit For
Next
End If
'****************** le nouveau solde du mois + limiter à 37.5 heures **************
aHistoire(1) = Application.Max(0, temp1 + aValeurs(1)) 'solde du mois + delta des transferts
Trop = Application.Max(0, Application.Sum(aHistoire) - iCSE_Max)
If Trop > 0 Then
For j1 = UBound(aHistoire) To 1 Step -1
temp2 = Application.Max(0, Application.Min(aHistoire(j1), Trop))
aHistoire(j1) = aHistoire(j1) - temp2
Trop = Trop - temp2
If Trop <= 0 Then Exit For
Next
End If
'************** écrire resultat vers tableau cumul
som = Application.Sum(aHistoire)
LO_Cum.DataBodyRange.Cells(i, j).Value = som
'************** pour mieux comprendre les choses, output vers dictionaire
ReDim aOut(1 To 20)
For k = 0 To UBound(aValeurs)
aOut(3 + k) = aValeurs(k)
Next
aOut(8) = som
aOut(9) = Join(Application.Transpose(Application.Transpose(aHistoire)), "|")
If Len(Replace(Replace(Join(aOut, "|"), "|", ""), "0", "")) > 0 Then
aOut(1) = sNom
aOut(2) = aMois(1, j)
Dict.Add Dict.Count, aOut
End If
Next
Next
With Range("tbl_details").ListObject
If .ListRows.Count > 1 Then .DataBodyRange.Offset(1).Resize(.ListRows.Count - 1).Delete
If .ListRows.Count = 0 Then .ListRows.Add
If Dict.Count > 1 Then .DataBodyRange.Resize(Dict.Count, 9).Value = Application.Index(Dict.items, 0, 0)
End With
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Pour la partie global année ,j’ai rajouté un onglet et cela fonctionne parfaitement ,je bloque juste sur la partie macro et l’ajout du tableau « tbl_ds »
SAISIE HEURES CSE(1).xlsm (129,4 Ko)
