XL 2010 Vba modifier les cellules sous mfc

Pinierdavid

XLDnaute Nouveau
Bonsoir

je suis nouveau sur le forum je recherche une solution pour agir en vba sur des cellules sous mfc ( avec formule si par rapport à une autre cellule ).
C’est un planning de prod avec des dates si c’est un jour fériés toutes les cases correspondant à ce jour pour chaque employer se mettent en noir et j’aimerais mettre l’a valeurs des case à zéro
J’ai chercher mais je n’est pas trouver de solution sur les différents forums
Si quelqu’un peut m’aider je suis preneur
 

Pinierdavid

XLDnaute Nouveau
Je pense que je m’exprime mal je ne peu pas mettre de formule dans les où il y a 1 car je doit par la suite le remplacer par du texte
Je veut juste savoir comment je dois me servir de ma formule pour la mfc dans une macro pour mettre automatiquement les cellules en fond rouge à zero
J’ai vu que c’était possible mais je n’arrive pas à le mettre en œuvre
 

Pinierdavid

XLDnaute Nouveau
Option Explicit

Sub Effacer()
Dim Cell As Range
Dim Feuille As Worksheet

If MsgBox("Etes-vous sûr de vouloir effacer toutes les données saisies ?", vbYesNo) = vbYes Then
For Each Feuille In Worksheets

On Error Resume Next
For Each Cell In Feuille.Cells.SpecialCells(xlCellTypeAllFormatConditions)
With Cell.FormatConditions(1)
If .Type = xlExpression And .Formula1 = "=NB.SI($D$1;$D$2)>0" Then Cell.ClearContents
End With
Next Cell
Next Feuille
End If

End Sub
 

Dudu2

XLDnaute Barbatruc
Je pense que je m’exprime mal je ne peu pas mettre de formule dans les où il y a 1 car je doit par la suite le remplacer par du texte
C'est faux. Tu peux remplacer ta formule par du texte. Je ne comprends pas pourquoi tu bloques là-dessus. C'est la solution simple.

J’ai vu que c’était possible mais je n’arrive pas à le mettre en œuvre
Le faire avec du code, bien sûr pourquoi faire simple quand on peut faire compliqué, à condition de savoir à quel moment ce code doit s'exécuter ? En pressant un bouton, en modifiant une cellule quelque part (où ?), en activant la feuille ? Quand ? Ce code ne va pas se déclencher par magie au moment où tu penses que c'est opportun.
 

Dudu2

XLDnaute Barbatruc
Je te donne 2 versions de ton programme Effacer adapté.

La première (Effacer1) manipule les cellules et dure longtemps car il y a beaucoup de cellules à scanner ($R$6:$CI$90).

La deuxième (Effacer2) charge les cellules en table et ça va 10 ? 20 ? fois plus vite.
Edit: code modifié pour récupérer le AppliesTo Range de la MFC au lieu de le coder en dur.

Je te laisse régler la question du déclenchement de cette macro à ta guise.
Mais elle ne se déclenchera pas par transmission de pensée.

VB:
Option Explicit

Sub Effacer1()
    Dim Cell As Range
    Dim Feuille As Worksheet
    Dim i As Integer
    Dim AppliesToRange As Range
  
    If MsgBox("Etes-vous sûr de vouloir effacer toutes les données saisies ?", vbYesNo) = vbYes Then
        On Error Resume Next
        Set Feuille = ActiveSheet
      
        'Recherche de la MFC concernée
        Set Cell = Feuille.Cells.Range("$R$6:$CI$90").SpecialCells(xlCellTypeAllFormatConditions).Cells(1, 1)
        For i = 1 To Cell.FormatConditions.Count
            With Cell.FormatConditions(i)
                If .Type = xlExpression And .Formula1 = "=SI(R$1:$CI$1>$D$203;1;SI(R$1:$CI$1<$D$202;1;0))" Then
                    Set AppliesToRange = .AppliesTo
                    Exit For
                End If
            End With
        Next i
        If i > Cell.FormatConditions.Count Then
            MsgBox "La MFC n'a pas été trouvée telle qu'attendue:" & vbCrLf & _
                   "Formule: =SI(R$1:$CI$1>$D$203;1;SI(R$1:$CI$1<$D$202;1;0))"
            Exit Sub
        End If
      
        For Each Cell In AppliesToRange.Cells
            If Cell.Value = 1 Then
                If Feuille.Cells(1, Cell.Column) > Feuille.Range("$D$203").Value _
                Or Feuille.Cells(1, Cell.Column) < Feuille.Range("$D$202").Value Then
                    'MsgBox Cell.Address
                    Cell.Value = 0
                End If
            End If
        Next Cell
    End If
End Sub


Sub Effacer2()
    Dim Cell As Range
    Dim Feuille As Worksheet
    Dim T() As Variant
    Dim d As Variant
    Dim d1 As Variant
    Dim d2 As Variant
    Dim i As Integer
    Dim j As Integer
    Dim AppliesToRange As Range
  
    If MsgBox("Etes-vous sûr de vouloir effacer toutes les données saisies ?", vbYesNo) = vbYes Then
        On Error Resume Next
        Set Feuille = ActiveSheet
      
        'Recherche de la MFC concernée
        Set Cell = Feuille.Cells.Range("$R$6:$CI$90").SpecialCells(xlCellTypeAllFormatConditions).Cells(1, 1)
        For i = 1 To Cell.FormatConditions.Count
            With Cell.FormatConditions(i)
                If .Type = xlExpression And .Formula1 = "=SI(R$1:$CI$1>$D$203;1;SI(R$1:$CI$1<$D$202;1;0))" Then
                    Set AppliesToRange = .AppliesTo
                    Exit For
                End If
            End With
        Next i
        If i > Cell.FormatConditions.Count Then
            MsgBox "La MFC n'a pas été trouvée telle qu'attendue:" & vbCrLf & _
                   "Formule: =SI(R$1:$CI$1>$D$203;1;SI(R$1:$CI$1<$D$202;1;0))"
            Exit Sub
        End If
      
        T = AppliesToRange.Value
        d1 = Feuille.Range("$D$203").Value
        d2 = Feuille.Range("$D$202").Value
      
        For i = 1 To UBound(T, 1)
            For j = 1 To UBound(T, 2)
                If T(i, j) = 1 Then
                    d = Feuille.Cells(1, j + 17).Value
                    If d > d1 Or d < d2 Then
                        'MsgBox Cell.Address
                        T(i, j) = 0
                    End If
                End If
            Next j
        Next i
      
        AppliesToRange.Value = T
    End If
End Sub
 
Dernière édition:

Pinierdavid

XLDnaute Nouveau
merci cela fonctionne parfaitement, si cela ne te dérange pas je voudrais le faire pour les autres formule qui récupère des informations sur une autre feuille donc jai essayer de retravailler ton code mais cela ne fonctionne pas
je pense que je me suis tromper quelque part
 

Pinierdavid

XLDnaute Nouveau
Sub Effacer2()
Dim Cell As Range
Dim ws As Worksheet
Dim T() As Variant
Dim d As Variant
Dim d1 As Variant
Dim d2 As Variant
Dim i As Integer
Dim j As Integer

If MsgBox("Etes-vous s?r de vouloir effacer toutes les donn?es saisies ?", vbYesNo) = vbYes Then
On Error Resume Next
Set Feuille = ActiveSheet

'Recherche de la MFC concern?e
Set Cell = Feuille(1).Cells.Range("$R$6:$CI$90").SpecialCells(xlCellTypeAllFormatConditions).Cells(1, 1)
For i = 1 To Cell.FormatConditions.Count
With Cell.FormatConditions(i)
If .Type = xlExpression And .Formula1 = "=SI(R$1:$CI$1=CALENDRIER!$V$3;1;SI(R$1:$CI$1=CALENDRIER!$V$4;1;SI(R$1:$CI$1=CALENDRIER!$V$5;1;SI(R$1:$CI$1=CALENDRIER!$V$6;1;SI(R$1:$CI$1=CALENDRIER!$V$7;1;SI(R$1:$CI$1=CALENDRIER!$V$8;1;SI(R$1:$CI$1=CALENDRIER!$V$9;1;SI(R$1:$CI$1=CALENDRIER!$V$10;1;SI(R$1:$CI$1=CALENDRIER!$V$11;1;SI(R$1:$CI$1=CALENDRIER!$V$12;1;SI(R$1:$CI$1=CALENDRIER!$V$13;1;SI(R$1:$CI$1=CALENDRIER!$V$14;1;SI(R$1:$CI$1=CALENDRIER!$V$15;1;SI(R$1:$CI$1=CALENDRIER!$V$16;1;0))))))))))))))" Then Exit For
End With
Next i
If i > Cell.FormatConditions.Count Then
MsgBox "La MFC n'a pas ?t? trouv?e telle qu'attendue:" & vbCrLf & _
"S'applique ?: $R$6:$CI$90" & vbCrLf & _
"Formule: =SI(R$1:$CI$1=CALENDRIER!$V$3;1;SI(R$1:$CI$1=CALENDRIER!$V$4;1;SI(R$1:$CI$1=CALENDRIER!$V$5;1;SI(R$1:$CI$1=CALENDRIER!$V$6;1;SI(R$1:$CI$1=CALENDRIER!$V$7;1;SI(R$1:$CI$1=CALENDRIER!$V$8;1;SI(R$1:$CI$1=CALENDRIER!$V$9;1;SI(R$1:$CI$1=CALENDRIER!$V$10;1;SI(R$1:$CI$1=CALENDRIER!$V$11;1;SI(R$1:$CI$1=CALENDRIER!$V$12;1;SI(R$1:$CI$1=CALENDRIER!$V$13;1;SI(R$1:$CI$1=CALENDRIER!$V$14;1;SI(R$1:$CI$1=CALENDRIER!$V$15;1;SI(R$1:$CI$1=CALENDRIER!$V$16;1;0))))))))))))))"
Exit Sub
End If

T = Feuille(1).Cells.Range("$R$6:$CI$90").Value
d1 = Feuille(2).Range("$V$3").Value
d2 = Feuille(2).Range("$V$4").Value
d3 = Feuille(2).Range("$V$5").Value
d4 = Feuille(2).Range("$V$6").Value
d5 = Feuille(2).Range("$V$7").Value
d6 = Feuille(2).Range("$V$8").Value
d7 = Feuille(2).Range("$V$9").Value
d8 = Feuille(2).Range("$V$10").Value
d9 = Feuille(2).Range("$V$11").Value
d10 = Feuille(2).Range("$V$12").Value
d11 = Feuille(2).Range("$V$13").Value
d12 = Feuille(2).Range("$V$14").Value
d13 = Feuille(2).Range("$V$15").Value
d14 = Feuille(2).Range("$V$16").Value
d15 = Feuille(2).Range("$V$17").Value
For i = 1 To UBound(T, 1)
For j = 1 To UBound(T, 2)
If T(i, j) = 1 Then
d = Feuille(1).Cells(1, j + 17).Value
If d = d1 Or d = d2 Or d = d3 Or d = d4 Or d = d5 Or d = d6 Or d = d7 Or d = d8 Or d = d9 Or d = d10 Or d = d11 Or d = d12 Or d = d13 Or d = d15 Then
'MsgBox Cell.Address
T(i, j) = ""
End If
End If
Next j
Next i

Feuille(1).Cells.Range("$R$6:$CI$90").Value = T
End If
End Sub
 

Pinierdavid

XLDnaute Nouveau
voila le planning en totalité
ce que je voudrais faire
toutes les cases en surbrillance rouge (jours en dehors du mois de la feuille) effacer le contenu la macro fonctionne pour une feuille mais j'aimerais pour les feuilles "janvier à janvier n+1"
toutes les cases en surbrillances noirs (jours fériés issu de la feuille calendrier) effacer le contenu dans les feuilles "janvier à janvier N+1"
les cases en surbrillances rouge (jours de congés renseigner dans le planning personnel ) effacer le contenu dans les feuille "janvier à janvier n+1"
j'en demande beaucoup mais j'ai vraiment du mal à comprendre le langage et la structure des macros
si quelqu'un peut m'aider je suis preneur
 

Dudu2

XLDnaute Barbatruc
J'ai fait une petite modif tout à l'heure dans le code fourni hier soir. Un détail qui ne change rien en l'état des choses mais ce serait bon de le reprendre car s'adapte automatiquement au Range de la MFC.
Ça règlerait d'ailleurs peut-être ton problème.
Là tu fais référence à une MFC que je ne vois pas sur le classeur fourni au début.
Donc c'est difficile de vérifier sans le fichier complet.
 

Dudu2

XLDnaute Barbatruc
il ne marche pas le fichier zip ?
Si ça marche. Mais si tu veux appliquer la macro à toutes les feuilles de mois:
- d'une part il faut déterminer soit les noms soit les numéros des feuilles concernées:
Est-ce que c'est toujours les 12 ou 13 ou N premières feuilles ? Sinon quel critère pour déterminer les feuilles ?
- d'autre part s'attendre à un temps d'exécution multiplié d'autant.
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 920
Membres
101 840
dernier inscrit
SamynoT