[RESOLU]Report suivant conditions

Ternoise · 28 Janvier 2014

Bonsoir le Forum

Je me retrouve, une fois de plus avec un problème
En pièce jointe, mon fichier épuré.

Ce code me convenait très bien depuis la première utilisation.

.FormulaR1C1 = "=SUMPRODUCT((INDEX(T,,2)=RC2)*(INDEX(T,,3)=R11C),INDEX(T,,9)+INDEX(T,,10))"
.Value = .Value 'supprime les formules
.Interior.Color = &HFF00&

Avec le temps j'aimerais ajouter une condition suivant la valeur d'une autre colonne
L'explication est dans le module 1

Pouvez-vous m'aider ?

Merci

Ternoise · 29 Janvier 2014

Re : Report suivant conditions

Re à tous

C'est un code dans ce style que je recherche !

Sub Actualisation()
Application.EnableEvents = False

Sheets("DIRECTION").Range("B9:R" & Sheets("DIRECTION").[C65536].End(xlUp).Row).Name = "T"

With [C12].Resize([B21].End(xlUp).Row - 11, [Q11].End(xlToLeft).Column - 2)

'Si "samedi repos" indiquer "REPOS" dans la cellule
If (Index(T, , 2) = RC2) * (Index(T, , 3) = R11C) * (Index(T, , 4) = "SAMEDI REPOS") Then
.FormulaR1C1 = "=(INDEX(T,,2)=RC2)*(INDEX(T,,3)=R11C),""REPOS"""
.Value = .Value
.Interior.Color = &HC000&

Else

'Si "Jour Férié" indiquer "JF" dans la cellule
If (Index(T, , 2) = RC2) * (Index(T, , 3) = R11C) * (Index(T, , 4) = "JOUR FERIE") Then
.FormulaR1C1 = "=(INDEX(T,,2)=RC2)*(INDEX(T,,3)=R11C),""JF"""
.Value = .Value
.Interior.Color = &HC000&

Else

'Si Coef ou Effectif (fonctionne parfaitement)
.FormulaR1C1 = "=SUMPRODUCT((INDEX(T,,2)=RC2)*(INDEX(T,,3)=R11C),INDEX(T,,9)+INDEX(T,,10))"
.Value = .Value
.Interior.Color = &HFF00&

End If
End If

End With
Sheets("DIRECTION").Range("B9:R" & Application.Match("zzz", Sheets("DIRECTION").[C:C])).Name = "T"
Application.EnableEvents = True
End Sub

Merci de toute aide
David

job75 · 29 Janvier 2014

Re : Report suivant conditions

Bonjour Ternoise,

Avec plusieurs types de valeurs pour le tableau, l'entrée d'une formule SOMMEPROD n'est pas la bonne méthode.

Utilisez cette macro :

Code:

Sub Actualisation()
Dim t, ub&, P As Range, i&, nom$, j%, dat#, k&
t = Sheets("DIRECTION").Range("B9:R" & Sheets("DIRECTION").[C65536].End(xlUp).Row)
ub = UBound(t)
Set P = [C12].Resize([B21].End(xlUp).Row - 11, [Q11].End(xlToLeft).Column - 2)
Application.ScreenUpdating = False
Application.EnableEvents = False
P.ClearContents 'RAZ
For i = 1 To P.Rows.Count
  nom = P(i, 0)
  For j = 1 To P.Columns.Count
    dat = P(0, j)
    For k = 1 To ub
      If t(k, 2) = nom And t(k, 3) = dat Then
        P(i, j) = t(k, 9) + t(k, 10)
        If t(k, 4) Like "*REPOS*" Then P(i, j) = "REPOS"
        If t(k, 4) Like "*FERIE*" Then P(i, j) = "JF"
        If t(k, 4) Like "*MALADIE*" Then P(i, j) = "MAL"
        Exit For
      End If
    Next
  Next
Next
Application.EnableEvents = True
End Sub

J'ai aussi créé une MFC à 3 conditions sur le tableau.

Fichier joint.

A+

Ternoise · 29 Janvier 2014

Re : Report suivant conditions

Bonjour Job75

C'est exactement ce que je recherche.
Manque les couleurs suivant chaque condition !

Sinon c'est nickel
Merci

job75 · 29 Janvier 2014

Re : Report suivant conditions

Re,

Ternoise à dit:
Manque les couleurs suivant chaque condition !

Inutile de les appliquer par macro puisqu'il est facile de le faire, comme je l'ai fait, par MFC.

A+

Ternoise · 29 Janvier 2014

Re : Report suivant conditions

Re Job75

job75 à dit:
Re,
comme je l'ai fait, par MFC.

Oui j'ai vu mais j'ai d'autres conditions que j'ajoute à la macro et avec ma version 2003, je suis limité à 3 conditions.
mais également pour la suite et fin de mon projet

Merci une nouvelle fois de l'aide
David

job75 · 29 Janvier 2014

Re : Report suivant conditions

Re,

C'est le genre de truc que vous devez maintenant pouvoir programmer tout seul :

Code:

Sub Actualisation()
Dim t, ub&, P As Range, i&, nom$, j%, dat#, k&
t = Sheets("DIRECTION").Range("B9:R" & Sheets("DIRECTION").[C65536].End(xlUp).Row)
ub = UBound(t)
Set P = [C12].Resize([B21].End(xlUp).Row - 11, [Q11].End(xlToLeft).Column - 2)
Application.ScreenUpdating = False
Application.EnableEvents = False
P.ClearContents 'RAZ
P.Interior.ColorIndex = 36 'jaune clair
For i = 1 To P.Rows.Count
  nom = P(i, 0)
  For j = 1 To P.Columns.Count
    dat = P(0, j)
    For k = 1 To ub
      If t(k, 2) = nom And t(k, 3) = dat Then
        P(i, j) = t(k, 9) + t(k, 10): P(i, j).Interior.ColorIndex = 4 'vert
        If t(k, 4) Like "*REPOS*" Then P(i, j) = "REPOS": P(i, j).Interior.ColorIndex = 6
        If t(k, 4) Like "*FERIE*" Then P(i, j) = "JF": P(i, j).Interior.ColorIndex = 45
        If t(k, 4) Like "*MALADIE*" Then P(i, j) = "MAL": P(i, j).Interior.ColorIndex = 3
        Exit For
      End If
    Next
  Next
Next
Application.EnableEvents = True
End Sub

Sub CodeCouleur() 'permet de connaître chaque code couleur
MsgBox ActiveCell.Interior.ColorIndex
End Sub

J'ai bien sûr retiré la MFC.

A+

job75 · 29 Janvier 2014

Re : Report suivant conditions

Re,

Une chose évidente, mais qu'il est bon de rappeler semble-t-il 🙄

Quand il y a plus de 3 couleurs dans un tableau ça exaspère l'utilisateur car il faut avoir en tête à quoi elles correspondent.

A+

Ternoise · 29 Janvier 2014

Re : Report suivant conditions

Re,
Merci beaucoup cela fonctionne a merveille
Je me retrouve donc avec une dernière difficulté.

Avant votre code, j'ai intégré une copie du tableau vers un autre emplacement.
Après le code, j'avais intégré un petit bout de code provenant de Si...

' For Each C In [C12😛20]
' If Not IsNumeric(C) Then C(1, 25).Copy C
' Next

qui me permettais de remplacer les valeurs non numérique. Forcement cela ne convient plus.

J'aimerais donc un code qui remplace seulement les cellules vides.
Une idée pour cela ?

' If Not IsNumeric(C) Then C(1, 25).Copy C

Sinon...

C'est le genre de truc que vous devez maintenant pouvoir programmer tout seul

Sachez que j’essaie toujours de me débrouiller mais pas facile quand on débute en VBA. L'age y fait peut être aussi !

plus de 3 couleurs dans un tableau ça exaspère

Depuis 5 ans nous travaillons avec ces couleurs donc cela ne gène pas.

Mille merci de votre aide

Ternoise · 29 Janvier 2014

Re : Report suivant conditions

Re

Solution toute bête trouvée

If (C) = "" Then C(1, 25).Copy C

Merci pour tous

[RESOLU]Report suivant conditions

Ternoise

XLDnaute Occasionnel

Pièces jointes

Ternoise

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

Ternoise

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Ternoise

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Ternoise

XLDnaute Occasionnel

Pièces jointes

Ternoise

XLDnaute Occasionnel

Discussions similaires

[RESOLU]Report suivant conditions

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency