Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Mefc en VBA (bis)

16 réponses
Avatar
guy boily
Bonjour,
Un grand Merci à tous ceux et celles qui ont répondu à mon appel à l'aide
et croyez-bien que j'ai l'intention dans le futur de mettre vos commentaires
à profit. Mais j'aurais à nouveau besoin de votre aide. J'ai fait part de ma
question dans mon message du 23 novembre (Mefc en VBA) à la suite de la
réponse de FFO. Pourriez-vous s.v.p. m'aider à nouveau?

Merci

--
boily_SLSJ

10 réponses

1 2
Avatar
Fredo P.
J'ai exécuté tes deux Private SubWorkbook_SheetCalculate(ByVal sh As Object)
sans rencontrer de Pb. Il faut contrôler tes données si elles sont toutes
numériques.
"guy boily" a écrit dans le message de
news:
Bonjour,
Un grand Merci à tous ceux et celles qui ont répondu à mon appel à l'aide
et croyez-bien que j'ai l'intention dans le futur de mettre vos


commentaires
à profit. Mais j'aurais à nouveau besoin de votre aide. J'ai fait part de


ma
question dans mon message du 23 novembre (Mefc en VBA) à la suite de la
réponse de FFO. Pourriez-vous s.v.p. m'aider à nouveau?

Merci

--
boily_SLSJ


Avatar
guy boily
Bonjour Fredo P.

Tu as mis dans le mille....j'avais bien une valeur non numérique qui m'a
échappée. Maintenant tout fonctionne à merveille. Mes trois lignes sont
comparées et coloriées.
De plus j'ai ajouté dans un module cette fonction que j'ai trouvée sur ce
forum et toutes mes couleurs sont bien comptées... après avoir forcé un
recalculate en me déplaçant dans la feuille; je m'explique...

Les données de ma feuille sont fonction d'un code que je choisi dans une
liste déroulante. Après la mise à jour du code dans la liste toutes les
cellules ne recoivent pas la couleur voulue; il faut que je change de cellule
au moins une fois pour que le recalcul soit fait au complet.

Aurais-tu une proposition pour éviter que je sois obligé de changer de
cellule pour forcer un recalcul après que j'ai choisi mon code dans ma liste
déroulante?

Function SomCool(Zne As Range, Couleur As String)
Application.Volatile True
Select Case Couleur
Case "rouge"
Couleur = 3
Case "vert"
Couleur = 4
Case "jaune"
Couleur = 6
Case "bleu"
Couleur = 5
Case "gris"
Couleur = 15
Case "orange"
Couleur = 40
End Select
For Each cell In Zne
If cell.Interior.ColorIndex = Couleur Then cvSomme = cvSomme + 1
'NB : si tu veux dénombrer seulement les cellules d'une couleur donnée,
remplace
' cvSomme= cvSomme+ cell.value par cvSomme=cvSomme+1

Next
SomCool = cvSomme
End Function

Pour compter mes couleurs j'ai mis da ma feuille =somcool(e8:ab8;"rouge")
et ainsi de suite pour vert et jaune...et c'est nickel.

Merci pour tout.


--
boily_SLSJ


"Fredo P." a écrit :

J'ai exécuté tes deux Private SubWorkbook_SheetCalculate(ByVal sh As Object)
sans rencontrer de Pb. Il faut contrôler tes données si elles sont toutes
numériques.
"guy boily" a écrit dans le message de
news:
> Bonjour,
> Un grand Merci à tous ceux et celles qui ont répondu à mon appel à l'aide
> et croyez-bien que j'ai l'intention dans le futur de mettre vos
commentaires
> à profit. Mais j'aurais à nouveau besoin de votre aide. J'ai fait part de
ma
> question dans mon message du 23 novembre (Mefc en VBA) à la suite de la
> réponse de FFO. Pourriez-vous s.v.p. m'aider à nouveau?
>
> Merci
>
> --
> boily_SLSJ





Avatar
Fredo P.
Aurais-tu une proposition pour éviter que je sois obligé de changer de
cellule pour forcer un recalcul après que j'ai choisi mon code dans ma


liste
déroulante?


Essai en changeant cette ligne
Private SubWorkbook_SheetCalculate(ByVal sh As Object)
par celle-ci
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)


Function SomCool(Zne As Range, Couleur As String)
Application.Volatile True
Select Case Couleur
Case "rouge"
Couleur = 3
Case "vert"
Couleur = 4
Case "jaune"
Couleur = 6
Case "bleu"
Couleur = 5
Case "gris"
Couleur = 15
Case "orange"
Couleur = 40
End Select
For Each cell In Zne
If cell.Interior.ColorIndex = Couleur Then cvSomme = cvSomme + 1
'NB : si tu veux dénombrer seulement les cellules d'une couleur donnée,
remplace
' cvSomme= cvSomme+ cell.value par cvSomme=cvSomme+1

Next
SomCool = cvSomme
End Function

Pour compter mes couleurs j'ai mis da ma feuille =somcool(e8:ab8;"rouge")
et ainsi de suite pour vert et jaune...et c'est nickel.

Merci pour tout.


--
boily_SLSJ


"Fredo P." a écrit :

> J'ai exécuté tes deux Private SubWorkbook_SheetCalculate(ByVal sh As


Object)
> sans rencontrer de Pb. Il faut contrôler tes données si elles sont


toutes
> numériques.
> "guy boily" a écrit dans le message


de
> news:
> > Bonjour,
> > Un grand Merci à tous ceux et celles qui ont répondu à mon appel à


l'aide
> > et croyez-bien que j'ai l'intention dans le futur de mettre vos
> commentaires
> > à profit. Mais j'aurais à nouveau besoin de votre aide. J'ai fait part


de
> ma
> > question dans mon message du 23 novembre (Mefc en VBA) à la suite de


la
> > réponse de FFO. Pourriez-vous s.v.p. m'aider à nouveau?
> >
> > Merci
> >
> > --
> > boily_SLSJ
>
>
>


Avatar
FFO
Salut guy
Excuses moi si je n'ai pu te répondre d'autres obligations m'ont appelé
ailleur

J'ai lu ton adaptation de mon code et voudrai t'apporter une précision

Lorsque tu utilises 2 boucles :

For i For j
soit tu les imbriques l'une dans l'autre comme tu l'as fait :

For i = 5 To 28
For k = 5 To 28
If Cells(8, i) < Cells(12, i) And Cells(8, i) < Cells(6, 3) Then
Cells(8, i).Interior.ColorIndex = 3
End If
If Cells(8, i) > Cells(12, i) Then
Cells(8, i).Interior.ColorIndex = 6
End If
If Cells(8, i) < Cells(12, i) And Cells(8, i) > Cells(6, 3) Then
Cells(8, i).Interior.ColorIndex = 4
End If
If Cells(29, k) < Cells(33, k) And Cells(29, k) < Cells(6, 3) Then
Cells(29, k).Interior.ColorIndex = 3
End If
If Cells(29, k) > Cells(33, k) Then
Cells(29, k).Interior.ColorIndex = 6
End If
If Cells(29, k) < Cells(33, k) And Cells(29, k) > Cells(6, 3) Then
Cells(29, k).Interior.ColorIndex = 4
End If
Next k
Next i

soit tu les dissocies ainsi

For i = 5 To 28
If Cells(8, i) < Cells(12, i) And Cells(8, i) < Cells(6, 3) Then
Cells(8, i).Interior.ColorIndex = 3
End If
If Cells(8, i) > Cells(12, i) Then
Cells(8, i).Interior.ColorIndex = 6
End If
If Cells(8, i) < Cells(12, i) And Cells(8, i) > Cells(6, 3) Then
Cells(8, i).Interior.ColorIndex = 4
End If
Next i

For k = 5 To 28
If Cells(29, k) < Cells(33, k) And Cells(29, k) < Cells(6, 3) Then
Cells(29, k).Interior.ColorIndex = 3
End If
If Cells(29, k) > Cells(33, k) Then
Cells(29, k).Interior.ColorIndex = 6
End If
If Cells(29, k) < Cells(33, k) And Cells(29, k) > Cells(6, 3) Then
Cells(29, k).Interior.ColorIndex = 4
End If
Next k

Si tu les imbriques la 2° boucle (For k = 5 To 28 te concernant) se
déroulera à chaque boucle de la 1° (For i = 5 To 28 te concernant)

Ce n'est interessant que si la variable i de la première boucle a une
incidence sur le résultat de la 2° boucle
Pour celà il faudrait que la variable i de la 1° boucle soit aussi une
variable de la 2° boucle en plus de la variable k
Par exemple :

If Cells(8, i+k) < Cells(12, i+k) And Cells(8, i+k) < Cells(6, 3) Then
Cells(8, i+k).Interior.ColorIndex = 3
End If

Or ce n'est pas le cas il n'y a aucune interaction entre les 2 variables des
2 boucles

Celà malgré tout n'altère pas le résultat mais alourdi considérablement le
traitement qui à chaque boucle de la 1° boucle éxécute la 2° boucle pour un
résultat toujours identique

Le phénomène s'accroit avec le nombre de boucles imbriqués

Je te conseille donc fortement si les variables de chaque boucle n'ont
aucune interaction entre elles de les dissociers
Ainsi tu traites ta 1° boucle puis tu traites ta 2° boucle
Et non pas ta 2° boucle autant de fois que la 1° boucle s'éxécute

Tu devrait gagner du temps d'éxécution

Fais des essais et dis moi !!!
Avatar
guy boily
Bonjour FFO

D'abord, Merci boucoup de me répondre. Effectivement il n'y a aucune
interaction entre les variables donc comme tu le suggère je garde mes
For...IF comme ils étaient..merci pour la leçon gratuite.

Pour ce qui est de ta suggestion pour Private Sub
Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) pour régler
mon problème de mise à jour des calculs...ça ne marche toujours pas. Il faut
encore que je me déplace dans la feuille après la mise à jour de ma liste
pour que les calculs se mettre à jour.

Merci boucoup..et si tu avais une autre idée ...n'hésites pas à me le faire
savoir.

Excuse mon retard à te revenir j'étais au bureau toute la journée et le site
du forum ne nous est pas accessible.




--
boily_SLSJ


"FFO" a écrit :

Salut guy
Excuses moi si je n'ai pu te répondre d'autres obligations m'ont appelé
ailleur

J'ai lu ton adaptation de mon code et voudrai t'apporter une précision

Lorsque tu utilises 2 boucles :

For i > For j >
soit tu les imbriques l'une dans l'autre comme tu l'as fait :

For i = 5 To 28
For k = 5 To 28
If Cells(8, i) < Cells(12, i) And Cells(8, i) < Cells(6, 3) Then
Cells(8, i).Interior.ColorIndex = 3
End If
If Cells(8, i) > Cells(12, i) Then
Cells(8, i).Interior.ColorIndex = 6
End If
If Cells(8, i) < Cells(12, i) And Cells(8, i) > Cells(6, 3) Then
Cells(8, i).Interior.ColorIndex = 4
End If
If Cells(29, k) < Cells(33, k) And Cells(29, k) < Cells(6, 3) Then
Cells(29, k).Interior.ColorIndex = 3
End If
If Cells(29, k) > Cells(33, k) Then
Cells(29, k).Interior.ColorIndex = 6
End If
If Cells(29, k) < Cells(33, k) And Cells(29, k) > Cells(6, 3) Then
Cells(29, k).Interior.ColorIndex = 4
End If
Next k
Next i

soit tu les dissocies ainsi

For i = 5 To 28
If Cells(8, i) < Cells(12, i) And Cells(8, i) < Cells(6, 3) Then
Cells(8, i).Interior.ColorIndex = 3
End If
If Cells(8, i) > Cells(12, i) Then
Cells(8, i).Interior.ColorIndex = 6
End If
If Cells(8, i) < Cells(12, i) And Cells(8, i) > Cells(6, 3) Then
Cells(8, i).Interior.ColorIndex = 4
End If
Next i

For k = 5 To 28
If Cells(29, k) < Cells(33, k) And Cells(29, k) < Cells(6, 3) Then
Cells(29, k).Interior.ColorIndex = 3
End If
If Cells(29, k) > Cells(33, k) Then
Cells(29, k).Interior.ColorIndex = 6
End If
If Cells(29, k) < Cells(33, k) And Cells(29, k) > Cells(6, 3) Then
Cells(29, k).Interior.ColorIndex = 4
End If
Next k

Si tu les imbriques la 2° boucle (For k = 5 To 28 te concernant) se
déroulera à chaque boucle de la 1° (For i = 5 To 28 te concernant)

Ce n'est interessant que si la variable i de la première boucle a une
incidence sur le résultat de la 2° boucle
Pour celà il faudrait que la variable i de la 1° boucle soit aussi une
variable de la 2° boucle en plus de la variable k
Par exemple :

If Cells(8, i+k) < Cells(12, i+k) And Cells(8, i+k) < Cells(6, 3) Then
Cells(8, i+k).Interior.ColorIndex = 3
End If

Or ce n'est pas le cas il n'y a aucune interaction entre les 2 variables des
2 boucles

Celà malgré tout n'altère pas le résultat mais alourdi considérablement le
traitement qui à chaque boucle de la 1° boucle éxécute la 2° boucle pour un
résultat toujours identique

Le phénomène s'accroit avec le nombre de boucles imbriqués

Je te conseille donc fortement si les variables de chaque boucle n'ont
aucune interaction entre elles de les dissociers
Ainsi tu traites ta 1° boucle puis tu traites ta 2° boucle
Et non pas ta 2° boucle autant de fois que la 1° boucle s'éxécute

Tu devrait gagner du temps d'éxécution

Fais des essais et dis moi !!!


Avatar
FFO
Rebonjour guy

" je garde mes
For...IF comme ils étaient.."

Dissociés donc je suppose ???

Concernant ta problématique
"Private Sub
Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) "

Je ne suis pas à l'origine de la proposition mais peux essayer de te trouver
une solution
Peux sur ce lien me transmettre ton document afin que je l'analyse :

http://www.cijoint.fr/index.php

communiques moi le lien pour que je le récupère
Avatar
guy boily
Bonjour FFO,

Après une journée de retard (encore le bureau...) voici le lien pour mon
fichier: CJ200811/cijfztkihr.xls

Merci pour le tracas que tu te donnes pour m'aider

Merci
Bye!


--
boily_SLSJ


"FFO" a écrit :

Rebonjour guy

" je garde mes
For...IF comme ils étaient.."

Dissociés donc je suppose ???

Concernant ta problématique
"Private Sub
Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) "

Je ne suis pas à l'origine de la proposition mais peux essayer de te trouver
une solution
Peux sur ce lien me transmettre ton document afin que je l'analyse :

http://www.cijoint.fr/index.php

communiques moi le lien pour que je le récupère



Avatar
guy boily
bonjour FFO
voici le lien au complet
merci

http://www.cijoint.fr/cjlink.php?file=cj200811/cijDw5vx5n.xls



--------------------------------------------------------------------------------

--
boily_SLSJ


"FFO" a écrit :

Rebonjour guy

" je garde mes
For...IF comme ils étaient.."

Dissociés donc je suppose ???

Concernant ta problématique
"Private Sub
Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) "

Je ne suis pas à l'origine de la proposition mais peux essayer de te trouver
une solution
Peux sur ce lien me transmettre ton document afin que je l'analyse :

http://www.cijoint.fr/index.php

communiques moi le lien pour que je le récupère



Avatar
FFO
Rebonjour guy

J'ai testé ton fichier
Si je choisi en C4 un nouveau mois le recalcul s'opère automatiquement

As tu le bon paramétrage dans :

Outils/Options
Onglet Calcul
Rubrique Calcul mettre "Automatique"

Verfies et dis moi !!!!
Avatar
guy boily
Bonjour FFO

Oui, ma case calcul automatique est cochée.
Il est vrai qu'en changeant le mois ou le code de bureau le calcul se fait
mais si immédiatement après avoir changé l'un ou l'autre on click dans une
autre cellule
alors excel effectue un autre calcul et mes sommecool sont changés...
essaie pour voir

Merci



--
boily_SLSJ


"FFO" a écrit :

Rebonjour guy

J'ai testé ton fichier
Si je choisi en C4 un nouveau mois le recalcul s'opère automatiquement

As tu le bon paramétrage dans :

Outils/Options
Onglet Calcul
Rubrique Calcul mettre "Automatique"

Verfies et dis moi !!!!



1 2