Formule à convertir en VBA

Le 24/04/2019 à 14:34

Je viens de modifier la formule, à toi de tester :

Sub Test()

    Dim Formule As String

    Formule = "=IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0,COUNTIF(H$35:H35,38)>0,"
    Formule = Formule & "COUNTIF(H$35:H35,35)>0,COUNTIF(H$35:H35,37)>0,COUNTIF(H$35:H35,36)>0,COUNTIF(H$35:H35,""cmo"")>0,COUNTIF(H$35:H35,32)>0,"
    Formule = Formule & "COUNTIF(H$35:H35,2)>0),""F"",IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0,"
    Formule = Formule & "COUNTIF(H$35:H35,38)>0,COUNTIF(H$35:H35,35)>0,COUNTIF(H$35:H35,37)>0,COUNTIF(H$35:H35,36)>0,COUNTIF(H$35:H35,""cmo"")>0,"
    Formule = Formule & "COUNTIF(H$35:H35,32)>0),2,IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0,"
    Formule = Formule & "COUNTIF(H$35:H35,38)>0,COUNTIF(H$35:H35,35)>0,COUNTIF(H$35:H35,37)>0,COUNTIF(H$35:H35,36)>0,COUNTIF(H$35:H35,""cmo"")>0),32,"
    Formule = Formule & "IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0,COUNTIF(H$35:H35,38)>0,COUNTIF(H$35:H35,35)>0,"
    Formule = Formule & "COUNTIF(H$35:H35,37)>0,COUNTIF(H$35:H35,36)>0),""cmo"",IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0,COUNTIF(H$35:H35,38)>0,"
    Formule = Formule & "COUNTIF(H$35:H35,35)>0,COUNTIF(H$35:H35,37)>0),36,IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0,COUNTIF(H$35:H35,38)>0,"
    Formule = Formule & "COUNTIF(H$35:H35,35)>0),37,IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0,COUNTIF(H$35:H35,38)>0),35,IF(AND(COUNTIF(H$35:H35,1)>0,"
    Formule = Formule & "COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0),38,IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0),39,IF(AND(COUNTIF(H$35:H35,1)>0,"
    Formule = Formule & "COUNTIF(H$35:H35,33)>0),30,IF(COUNTIF(H$35:H35,1)>0,33,1)))))))))))"

    Range("H36:BT127").Formula = Formule

End Sub

Le 24/04/2019 à 15:52

Hello Theze,

Parfait, elle s'incrit bien sur les cellules ! mais comment la rendre invisible?

Merci

Setila

Le 24/04/2019 à 17:15

Est-il possible de faire en sorte d'appliquer une condition sur cette formule afin qu'elle s'applique uniquement sur les cases blanches (créées par MFC) ?

Quelque chose du genre :

IF Case = white

Formule = "=IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0,COUNTIF(H$35:H35,38)>0,"

Formule = Formule & "COUNTIF(H$35:H35,35)>0,COUNTIF(H$35:H35,37)>0,COUNTIF(H$35:H35,36)>0,COUNTIF(H$35:H35,""cmo"")>0,COUNTIF(H$35:H35,32)>0,"

Formule = Formule & "COUNTIF(H$35:H35,2)>0),""F"",IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0,"

Formule = Formule & "COUNTIF(H$35:H35,38)>0,COUNTIF(H$35:H35,35)>0,COUNTIF(H$35:H35,37)>0,COUNTIF(H$35:H35,36)>0,COUNTIF(H$35:H35,""cmo"")>0,"

Formule = Formule & "COUNTIF(H$35:H35,32)>0),2,IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0,"

Formule = Formule & "COUNTIF(H$35:H35,38)>0,COUNTIF(H$35:H35,35)>0,COUNTIF(H$35:H35,37)>0,COUNTIF(H$35:H35,36)>0,COUNTIF(H$35:H35,""cmo"")>0),32,"

Formule = Formule & "IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0,COUNTIF(H$35:H35,38)>0,COUNTIF(H$35:H35,35)>0,"

Formule = Formule & "COUNTIF(H$35:H35,37)>0,COUNTIF(H$35:H35,36)>0),""cmo"",IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0,COUNTIF(H$35:H35,38)>0,"

Formule = Formule & "COUNTIF(H$35:H35,35)>0,COUNTIF(H$35:H35,37)>0),36,IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0,COUNTIF(H$35:H35,38)>0,"

Formule = Formule & "COUNTIF(H$35:H35,35)>0),37,IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0,COUNTIF(H$35:H35,38)>0),35,IF(AND(COUNTIF(H$35:H35,1)>0,"

Formule = Formule & "COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0,COUNTIF(H$35:H35,39)>0),38,IF(AND(COUNTIF(H$35:H35,1)>0,COUNTIF(H$35:H35,33)>0,COUNTIF(H$35:H35,30)>0),39,IF(AND(COUNTIF(H$35:H35,1)>0,"

Formule = Formule & "COUNTIF(H$35:H35,33)>0),30,IF(COUNTIF(H$35:H35,1)>0,33,1)))))))))))"

Range("H36:BT127").Formula = Formule

ELSE = rien

Globalement, les cases s'affichent en blanc si l'heure associée est comprise entre les deux valeurs sur le côté (voir MFC).

Merci d'avance,

Setila

Le 24/04/2019 à 18:30

Setila a écrit :
Hello Steelson,
oui ta formule me conviens mais elle ne fonctionne pas vraiment!
J'ai l'impression qu'elle ne va pas chercher dans l'onglet ordre.

as-tu nommé la zone "ordre" ?

je trouverais dommage de traîner une formule à rallonge difficilement maintenable !

Le 24/04/2019 à 19:14

Hello Steelson,

Oui je suis d'accord avec toi! je cherche qqch de simple!

Je viens d'essayer en nomant la zone mais ça ne fonctionne pas!

Merci

Setila

Le 24/04/2019 à 19:51

Bonjour,

A tester, en H36 :

=SIERREUR(INDEX({1;33;30;39;38;35;37;36;"cmo";32;2};MIN(SI(NB.SI(H$35:$H35;{1;33;30;39;38;35;37;36;"cmo";32;2});{99;99;99;99;99;99;99;99;99;99;99};LIGNE($1:$11))));"F")

formule matricielle à valider avec shift+ctrl+entrée

A tirer vers le bas. Si des formules sont supprimées (cellules grises), les suivantes s'adaptent et reprennent à l'interruption.

Si un n° de caisse est forcé manuellement (comme en ligne 35), il se trouve exclu ensuite.

eric

Le 24/04/2019 à 20:56

Hello eriic,

Merci pour tout aide!

Ta formule fonctionne mais quand je supprime la caisse 1 et n'est pas réatribuer?! j'ai l'impression que la formule ne tiens pas compte de la plage!

Aprés le code de Theze fonctionne mais j'aimerais que la formule apparaise uniquement sur les cellules de couleur blanches.

Et que les formules ne soient pas visible !

Merci

Setila

Le 24/04/2019 à 21:47

Ta formule fonctionne mais quand je supprime la caisse 1 et n'est pas réatribuer?!

chez moi si

j'ai l'impression que la formule ne tiens pas compte de la plage!

c'est une impression oui

eric

Le 25/04/2019 à 04:56

Setila a écrit :
Hello Steelson,
Oui je suis d'accord avec toi! je cherche qqch de simple!
Je viens d'essayer en nomant la zone mais ça ne fonctionne pas!
Merci
Setila

je te renvoie mon fichier

cela fonctionne à partir de H37, il faudrait adapter pour la ligne 36

1semaine-19-test-auto.xlsm (591.42 Ko)

Le 27/04/2019 à 13:14

Hello Eriic,

Désolé pour le retard mais déplacement oblige!!!

J'ai bien retester ta formule et elle fonctionne parfaitement!!!

Comment la mettre en VBA et peut par la même occasion ajouter ce code ci-dessous afin de supprimer les formule qui se mettent en cellules grises :

Sub delete()

Dim Sh As Worksheet

For Each Sh In Worksheets

With Sh

For Each Vcel In .Range("H35:BT127")

If Vcel.DisplayFormat.Interior.Color = RGB(128, 128, 128) Then

Vcel.Value = ""

End If

Next Vcel

End With

Un grand merci Eriic

Bonne journée,

Setila

Le 27/04/2019 à 13:23

Hello Steelson,

Merci pour le fichier.

Comme sur la capture d'écran lorsque je rentre une caisse qui est déjà attribué alors je me retrouve avec 2 caisses les mêmes!

La formule fonctionne jusqu'à se qu'on le fasse manuellement et là les caisses ne se réattribue plus correctement.

Merci beaucoup

Bonne journée,

Setila

Le 27/04/2019 à 17:33

Bonjour,

afin de supprimer les formule qui se mettent en cellules grises

le plus rapide est de ne rien mettre du tout vu que TOUTES tes cellules sont grises.

Celles apparaissant en blanc le sont par une MFC...

J'ai donc supprimé tes 3 MFC. La couleur doit être mise manuellement.

Par ailleurs, la formule partait du principe que tu remplissais manuellement la ligne 35 comme sur ton exemple.

Si ce n'est plus le cas, il lui faut quand même une ligne vide à insérer en 35 sinon on part sur une référence circulaire impossible à gérer.

Je démarre donc en ligne 36

D'autre part le "F" ne peut être à la fois le 1er et le dernier. J'ai fait le choix en dernier, et il se répète tant qu'il y a des lignes à remplir.

En premier il ne peut être mis que manuellement.

Sub poseFormule()
    Dim pl As Range, pl2 As Range, c As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set pl = Range("H36:BT127")
    pl.ClearContents
    For Each c In pl
        If c.Interior.ColorIndex = xlNone Then
            If pl2 Is Nothing Then Set pl2 = c Else Set pl2 = Union(pl2, c)
        End If
    Next c
    pl2.Formula = "=IFERROR(INDEX({1;33;30;39;38;35;37;36;""cmo"";32;2},MIN(IF(COUNTIF(R35C:R[-1]C,{1;33;30;39;38;35;37;36;""cmo"";32;2}),{99;99;99;99;99;99;99;99;99;99;99},ROW(R1:R11)))),""F"")"
    For Each c In pl2
        c.FormulaArray = c.Formula
    Next c
    Application.Calculation = xlCalculationAutomatic
    Set pl = Nothing: Set pl2 = Nothing: Set c = Nothing
End Sub

Si tu as peu de gris il faut un certain temps pour la mise en place. 12 s chez moi

eric

Le 27/04/2019 à 18:43

Hello eriic,

Erreur ?

Du coup en vba on ne peux pas faire appliquer une formule sur une couleur créé par mfc (blanc)?

Merci

Setila

Le 27/04/2019 à 19:11

Hello à tous,

Le code ci dessous fonctionne mais ne s'applique pas à tout les onglets ?

Et le code rame un peu ? qq'un peu m' aider à l'optimiser et à l'appliquer sur tout les onglets?

Sub Test()

Dim Formule As String

Dim Sh As Worksheet

For Each Sh In Worksheets

With Sh

Application.ScreenUpdating = False

Application.EnableEvents = False

Application.Calculation = xlCalculationManual