Adapter une formule matriciel en macro

chich · 19 Décembre 2017

Bonjour
comment adapter cette formule matriciel en macro pour la gestion des absence des 10 collaborateurs
Je souhaite que l'équivalent de cette formule s'applique pour le collaborateur 1 dans la plage(FU14 : TU14)
En fonction des dates de debut et de fin que je saisi dans les différente periode plus bas dans la feuille a la ligne 39 dans le fichier joint

{=SI(OU(ET(FU$3>=$FP39;FU$3<=$FR39);ET(FU$3>=$FS39;FU$3<=$FU39);ET(FU$3>=$FX39;FU$3<=$GB39);ET(FU$3>=$GE39;FU$3<=$GI39);ET(FU$3>=$GL39;FU$3<=$GP39));"CP";SI(OU(ET(FU$3>=$FP40;FU$3<=$FR40);ET(FU$3>=$FS40;FU$3<=$FU40);ET(FU$3>=$FX40;FU$3<=$GB40);ET(FU$3>=$GE40;FU$3<=$GI40);ET(FU$3>=$GL40;FU$3=$GP40));"CN";SI(OU(ET(FU$3>=$FP41;FU$3<=$FR41);ET(FU$3>=$FS41;FU$3<=$FU41);ET(FU$3>=$FX41;FU$3<=$GB41);ET(FU$3>=$GE41;FU$3<=$GI41);ET(FU$3>=$GL41;FU$3=$GP41));"CD";SI(OU(ET(FU$3>=$FP42;FU$3<=$FR42);ET(FU$3>=$FS42;FU$3<=$FU42);ET(FU$3>=$FX42;FU$3<=$GB42);ET(FU$3>=$GE42;FU$3<=$GI42);ET(FU$3>=$GL42;FU$3=$GP42));"MA";SI(OU(ET(FU$3>=$FP43;FU$3<=$FR43);ET(FU$3>=$FS43;FU$3<=$FU43);ET(FU$3>=$FX43;FU$3<=$GB43);ET(FU$3>=$GE43;FU$3<=$GI43);ET(FU$3>=$GL43;FU$3=$GP43));"MOD";SI(OU(ET(FU$3>=$FP44;FU$3<=$FR44);ET(FU$3>=$FS44;FU$3<=$FU44);ET(FU$3>=$FX44;FU$3<=$GB44);ET(FU$3>=$GE44;FU$3<=$GI44);ET(FU$3>=$GL44;FU$3=$GP44));"FOR";SI(OU(ET(FU$3>=$FP45;FU$3<=$FR45);ET(FU$3>=$FS45;FU$3<=$FU45);ET(FU$3>=$FX45;FU$3<=$GB45);ET(FU$3>=$GE45;FU$3<=$GI45);ET(FU$3>=$GL45;FU$3<=$GP45));"CCS";"")))))))}

J’espère être suffisamment explicite dans ma demande merci d'avance

vgendron · 20 Décembre 2017

Hello

essaie ce code dans un module standard

VB:

Sub formulesCumul()

Set ListeCollaborateurs = Range("FO14:FO23")

For Each Collaborateur In ListeCollaborateurs
    lig = Collaborateur.Row
    Set DebZone = Range("FO38:FO118").Find(Collaborateur, lookat:=xlWhole)
    If Not DebZone Is Nothing Then
        zoneCode = DebZone.Offset(1, 0).Resize(7, 1).Address
        DebPeriode1 = Range("FP" & DebZone.Row + 1).Resize(7).Address
        FinPeriode1 = Range("FR" & DebZone.Row + 1).Resize(7).Address
       
        DebPeriode2 = Range("FS" & DebZone.Row + 1).Resize(7).Address
        FinPeriode2 = Range("FU" & DebZone.Row + 1).Resize(7).Address
       
        DebPeriode3 = Range("FX" & DebZone.Row + 1).Resize(7).Address
        FinPeriode3 = Range("GB" & DebZone.Row + 1).Resize(7).Address
       
        DebPeriode4 = Range("GE" & DebZone.Row + 1).Resize(7).Address
        FinPeriode4 = Range("GI" & DebZone.Row + 1).Resize(7).Address
       
        DebPeriode5 = Range("GL" & DebZone.Row + 1).Resize(7).Address
        Finperiode5 = Range("GP" & DebZone.Row + 1).Resize(7).Address
       
       
        formule = "=IfError(INDEX(" & zoneCode & ",(sumproduct((FU3>=" & DebPeriode1 & ")*(FU3<=" & FinPeriode1 & ")*row(" & zoneCode & "))+sumproduct((FU3>=" & DebPeriode2 & ")*(FU3<=" & FinPeriode2 & ")*row(" & zoneCode & "))+sumproduct((FU3>=" & DebPeriode3 & ")*(FU3<=" & FinPeriode3 & ")*row(" & zoneCode & "))+sumproduct((FU3>=" & DebPeriode4 & ")*(FU3<=" & FinPeriode4 & ")*row(" & zoneCode & "))+sumproduct((FU3>=" & DebPeriode5 & ")*(FU3<=" & Finperiode5 & ")*row(" & zoneCode & ")))-38),"""")"

        Range("FU" & lig).Formula = formule
        Range("FU" & lig).Resize(1, 365).FillRight
    End If
   
Next Collaborateur
End Sub

thebenoit59 · 20 Décembre 2017

Bonjour chich.
Re-bonjour vgendron.

En adaptant ton fichier on pourrait trouver une réponse en formule.
Je te propose sur une seule période pour le moment, le mieux pour moi serait d'avoir les périodes les unes en dessous des autres.

chich · 21 Décembre 2017

vgendron à dit:

Hello

essaie ce code dans un module standard

VB:

Sub formulesCumul()

Set ListeCollaborateurs = Range("FO14:FO23")

For Each Collaborateur In ListeCollaborateurs
    lig = Collaborateur.Row
    Set DebZone = Range("FO38:FO118").Find(Collaborateur, lookat:=xlWhole)
    If Not DebZone Is Nothing Then
        zoneCode = DebZone.Offset(1, 0).Resize(7, 1).Address
        DebPeriode1 = Range("FP" & DebZone.Row + 1).Resize(7).Address
        FinPeriode1 = Range("FR" & DebZone.Row + 1).Resize(7).Address
      
        DebPeriode2 = Range("FS" & DebZone.Row + 1).Resize(7).Address
        FinPeriode2 = Range("FU" & DebZone.Row + 1).Resize(7).Address
      
        DebPeriode3 = Range("FX" & DebZone.Row + 1).Resize(7).Address
        FinPeriode3 = Range("GB" & DebZone.Row + 1).Resize(7).Address
      
        DebPeriode4 = Range("GE" & DebZone.Row + 1).Resize(7).Address
        FinPeriode4 = Range("GI" & DebZone.Row + 1).Resize(7).Address
      
        DebPeriode5 = Range("GL" & DebZone.Row + 1).Resize(7).Address
        Finperiode5 = Range("GP" & DebZone.Row + 1).Resize(7).Address
      
      
        formule = "=IfError(INDEX(" & zoneCode & ",(sumproduct((FU3>=" & DebPeriode1 & ")*(FU3<=" & FinPeriode1 & ")*row(" & zoneCode & "))+sumproduct((FU3>=" & DebPeriode2 & ")*(FU3<=" & FinPeriode2 & ")*row(" & zoneCode & "))+sumproduct((FU3>=" & DebPeriode3 & ")*(FU3<=" & FinPeriode3 & ")*row(" & zoneCode & "))+sumproduct((FU3>=" & DebPeriode4 & ")*(FU3<=" & FinPeriode4 & ")*row(" & zoneCode & "))+sumproduct((FU3>=" & DebPeriode5 & ")*(FU3<=" & Finperiode5 & ")*row(" & zoneCode & ")))-38),"""")"

        Range("FU" & lig).Formula = formule
        Range("FU" & lig).Resize(1, 365).FillRight
    End If
  
Next Collaborateur
End Sub

re
merci encore une très grande réactivité et efficacité
du coup serait il possible une version sans formules
merci d'avance

vgendron · 21 Décembre 2017

Hello
c'est surement possible.. avec la fonction evaluate.. mais la. je sèche.. je n'arrive pas à la mettre en oeuvre..
soit j'ai une erreur, soit, elle me renvoie la formule.....

chich · 21 Décembre 2017

Re
merci pour ton interet pour mon projet
j’espère que tu va trouver la voie

vgendron · 21 Décembre 2017

bon .j'ai posté une demande pour cette fonction Evaluate.;
en attendant, voici une solution simple et efficace..
on met les formules.. et on fait un copier coller special valeurs..

thebenoit59 · 21 Décembre 2017

Ne pourrait-on pas plutôt créer une fonction personnalisée, où tu indiques les différents champs de recherche ?

chich · 21 Décembre 2017

thebenoit59 à dit:
Ne pourrait-on pas plutôt créer une fonction personnalisée, où tu indiques les différents champs de recherche ?

Re merci pour ton intérêt
Pourquoi pas !

thebenoit59 · 21 Décembre 2017

Avec une fonction personnalisée.
Le code en détails :

VB:

Function planning_chich(dJour As Date, rRaisons As Range, rPeriode As Range) As String
Dim tRaisons(), tPeriodes()
Dim i As Byte, j As Byte

'Enregistre les raisons dans un tableau virtuel.
tRaisons = rRaisons.Value

'Enregistre la période dans un tableau virtuel.
tPeriodes = rPeriode.Value
'Vérifie qu'il y a bien trois colonnes pour la période.
If UBound(tPeriodes, 2) Mod 3 > 0 Then planning_chich = "Erreur": Exit Function

'Compare le nombre de lignes entre les Raisons et Périodes.
If UBound(tPeriodes) <> UBound(tRaisons) Then planning_chich = "Erreur nombre de lignes": Exit Function

'Boucle le tableau des Périodes à la recherche de la date.
For j = 1 To UBound(tPeriodes, 2) - 2 Step 3
    For i = LBound(tPeriodes) To UBound(tPeriodes)
        If dJour >= tPeriodes(i, j) And dJour <= tPeriodes(i, j + 2) Then
            planning_chich = tRaisons(i, 1)
            Exit Function
        End If
    Next i, j

End Function

chich · 22 Décembre 2017

thebenoit59 à dit:

Avec une fonction personnalisée.
Le code en détails :

VB:

Function planning_chich(dJour As Date, rRaisons As Range, rPeriode As Range) As String
Dim tRaisons(), tPeriodes()
Dim i As Byte, j As Byte

'Enregistre les raisons dans un tableau virtuel.
tRaisons = rRaisons.Value

'Enregistre la période dans un tableau virtuel.
tPeriodes = rPeriode.Value
'Vérifie qu'il y a bien trois colonnes pour la période.
If UBound(tPeriodes, 2) Mod 3 > 0 Then planning_chich = "Erreur": Exit Function

'Compare le nombre de lignes entre les Raisons et Périodes.
If UBound(tPeriodes) <> UBound(tRaisons) Then planning_chich = "Erreur nombre de lignes": Exit Function

'Boucle le tableau des Périodes à la recherche de la date.
For j = 1 To UBound(tPeriodes, 2) - 2 Step 3
    For i = LBound(tPeriodes) To UBound(tPeriodes)
        If dJour >= tPeriodes(i, j) And dJour <= tPeriodes(i, j + 2) Then
            planning_chich = tRaisons(i, 1)
            Exit Function
        End If
    Next i, j

End Function

Bonjour merci pour ton excellant travail
Ne serait il pas possible d' intégrer ta fonction avec une macro qui fait ce que fait ta formule
De façon a ne plus avoir de formules dans les cellules
Merci d'avance

thebenoit59 · 22 Décembre 2017

C'est tout à fait possible mais il n'y aura aucun recalcule.
Donc si tu ajoutes des dates ou en modifie tu dois relancer manuellement.

chich · 22 Décembre 2017

thebenoit59 à dit:
C'est tout à fait possible mais il n'y aura aucun recalcule.
Donc si tu ajoutes des dates ou en modifie tu dois relancer manuellement.

Re
OK ca me va
Je me demande si sa tiendrais la route avec l’événement
Private Sub Worksheet_Change(ByVal Target As Range)

thebenoit59 · 22 Décembre 2017

Ca pourrait être réalisé avec l'évènement.
Mais pour tout ça il faudrait avoir un fichier qui sera figé dans la liste des horaires, des types d'absences, des collaborateurs.

chich · 22 Décembre 2017

thebenoit59 à dit:
Ca pourrait être réalisé avec l'évènement.
Mais pour tout ça il faudrait avoir un fichier qui sera figé dans la liste des horaires, des types d'absences, des collaborateurs.

Tu veux quoi exactement dans ce fichier et je le prepare

Adapter une formule matriciel en macro

chich

XLDnaute Occasionnel

Pièces jointes

vgendron

XLDnaute Barbatruc

thebenoit59

XLDnaute Accro

Pièces jointes

chich

XLDnaute Occasionnel

vgendron

XLDnaute Barbatruc

chich

XLDnaute Occasionnel

vgendron

XLDnaute Barbatruc

Pièces jointes

thebenoit59

XLDnaute Accro

chich

XLDnaute Occasionnel

thebenoit59

XLDnaute Accro

Pièces jointes

chich

XLDnaute Occasionnel

thebenoit59

XLDnaute Accro

chich

XLDnaute Occasionnel

thebenoit59

XLDnaute Accro

chich

XLDnaute Occasionnel

Discussions similaires

Adapter une formule matriciel en macro

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Accro

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Accro

Pièces jointes

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency