Microsoft 365 Aide Keno

[Xav18]

Bonjour je fais appelle à vous car en haut je marque les 20 numéro du keno , ensuite en dessous j’ai 3 suite de numéro et quand sa correspond au tirage sa ce met en couleur. Ce que je voudrais si quelqu’un peut m’aider svp c’est avoir le total de mise en forme conditionnel pour chacune de mes 3 ligne de numéro en dessous pour m’éviter de compter tout le temps. Merci a vous

 

[Staple1600]

Re

J'ai regardé ton classeur
(mais je suis sous Excel 2013)
Et dans cette version, il n'y a pas de fonction COULEUR

Donc, j'ai testé avec cette macro
(mais comme les cellules sont fusionnées, je les ai défusionnées)
Et si je sélectionne la ligne 12, la MsgBox affiche 9

Sub test_II()
Dim c As Range, x
For Each c In Selection
If c.DisplayFormat.Interior.ColorIndex = Range("W8").DisplayFormat.Interior.ColorIndex Then
x = x + 1
End If
Next
MsgBox x
End Sub

 

[Xav18]

Re

J'ai regardé ton classeur
(mais je suis sous Excel 2013)
Et dans cette version, il n'y a pas de fonction COULEUR

Donc, j'ai testé avec cette macro
(mais comme les cellules sont fusionnées, je les ai défusionnées)
Et si je sélectionne la ligne 12, la MsgBox affiche 9

Sub test_II()
Dim c As Range, x
For Each c In Selection
If c.DisplayFormat.Interior.ColorIndex = Range("W8").DisplayFormat.Interior.ColorIndex Then
x = x + 1
End If
Next
MsgBox x
End Sub

Merci beaucoup je vais tester tout à l’heure je te tiens au courant

 

[Staple1600]

Re

Aprés recherche, la fonction COULEUR devait être une formule nommée avec une macroXL4 LIRE.CELLULE
Mais je ne suis pas sur cela fonctionne avec les couleurs de MFC
(cela fonctionne par contre sur Interior.Color)

 

[Staple1600]

Re

Toujours basé sur ton fichier exemple
(légérement modifié: cellules défusionnées)

Const Lignes = "12/15/18/21/24"
Sub Compter_Couleurs()
Dim i&, c As Range, x&
T = Split(Lignes, "/")
x = 0
For i = LBound(T) To UBound(T)
For Each c In Cells(T(i), 2).Resize(, 24)
If c.DisplayFormat.Interior.Color = Range("W8").DisplayFormat.Interior.Color Then
x = x + 1
Cells(T(i), "Z") = x
End If
Next c
x = 0
Next i
End Sub

Est-ce là le résultat que tu cherches?

 

[Staple1600]

Re

Voici le résultat que j'obtiens et comment j'ai modifié ta feuille.

 

[Xav18]

Re

Voici le résultat que j'obtiens et comment j'ai modifié ta feuille.
Regarde la pièce jointe 1093690

Sa c’est niquel sa me plais c’est sa je cherche tu peux me le renvoyer modifier comme sa stp c’est top merci beaucoup tu gère

 

[Staple1600]

Re

[Pour infos]
Ma philosophie c'est d'inciter le demandeur à mettre les mains dans le cambouis
Donc si tu as su fusionner les cellules, tu sauras les défusionner
C'est tout ce qu'il y a faire
Ca devrait te prendre moins de 7 minutes.
Si tu devais ne pas y arriver, je reviens dans 8 minutes avec une macro qui fera ces transformations à ta place.

 

[Xav18]

Re

[Pour infos]
Ma philosophie c'est d'inciter le demandeur à mettre les mains dans le cambouis
Donc si tu as su fusionner les cellules, tu sauras les défusionner
C'est tout ce qu'il y a faire
Ca devrait te prendre moins de 7 minutes.
Si tu devais ne pas y arriver, je reviens dans 8 minutes avec une macro qui fera ces transformations à ta place.

D’accord oui tu a raison c’est aussi le but de s’améliorer, mais il faut juste defusionner les cellules mais pour obtenir les chiffres au bout des lignes faut faire comment en tout cas vraiment merci de ton aide et pour le temps passer à m’aider

 

[Staple1600]

Re

Bah, il faut utiliser la macro que j'ai posté précédemment
(celle qui se trouve dans le message#19)
=>Alors pour commencer<=
ETAPE 1
Ci-dessous la macro pour modifier ta feuille

Sub Reagencement_Feuille()
Dim i&
Application.ScreenUpdating = False
Rows("12:13").MergeCells = False
Rows("16:17").MergeCells = False
Rows("20:21").MergeCells = False
Rows("24:25").MergeCells = False
Rows("28:29").MergeCells = False
Cells.ColumnWidth = 5.14
Rows("13:13").Delete Shift:=xlUp
Rows("16:16").Delete Shift:=xlUp
Rows("19:19").Delete Shift:=xlUp
Rows("22:22").Delete Shift:=xlUp
Rows("25:25").Delete Shift:=xlUp
Lignes = Array(12, 15, 18, 21, 24)
For i = LBound(Lignes) To UBound(Lignes)
Rows(Lignes(i)).RowHeight = 30
Next
End Sub

NB: Tu sais comment on lance une macro?
Si non, voir tutos sur le net.

ETAPE 2
Lancer la macro du message#19

 

[Xav18]

Re

Bah, il faut utiliser la macro que j'ai posté précédemment
(celle qui se trouve dans le message#19)
=>Alors pour commencer<=
ETAPE 1
Ci-dessous la macro pour modifier ta feuille

Sub Reagencement_Feuille()
Dim i&
Application.ScreenUpdating = False
Rows("12:13").MergeCells = False
Rows("16:17").MergeCells = False
Rows("20:21").MergeCells = False
Rows("24:25").MergeCells = False
Rows("28:29").MergeCells = False
Cells.ColumnWidth = 5.14
Rows("13:13").Delete Shift:=xlUp
Rows("16:16").Delete Shift:=xlUp
Rows("19:19").Delete Shift:=xlUp
Rows("22:22").Delete Shift:=xlUp
Rows("25:25").Delete Shift:=xlUp
Lignes = Array(12, 15, 18, 21, 24)
For i = LBound(Lignes) To UBound(Lignes)
Rows(Lignes(i)).RowHeight = 30
Next
End Sub

NB: Tu sais comment on lance une macro?
Si non, voir tutos sur le net.

ETAPE 2
Lancer la macro du message#19

J’ai fais c’est sa mais sa va encore pas car quand je change les chiffre mais j’ai trouvé je vais faire un bouton associer à la macro merci beaucoup à toi en tout cas

 

[Staple1600]

Re

C'est exactement cela, il faut ajouter un bouton et y affecter la macro Compter_Couleurs

Ou alors passer par une procédure évènementielle, ce que je vais faire de ce pas.

 

[Xav18]

Re

C'est exactement cela, il faut ajouter un bouton et y affecter la macro Compter_Couleurs

Ou alors passer par une procédure évènementielle, ce que je vais faire de ce pas.

J’ai juste un truc à modifier est ce que tu peux me ré appliquer à toute mes lignes merci beaucoup je te joins le fichier modifié

 

[Staple1600]

Re

Donc avant de regarder ton nouveau fichier
Voici ma proposition pour la procédure évènementielle.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([C3:L4], Target) Is Nothing Then
Call Compter_Couleurs
End If
End Sub

 

[Xav18]

Re

Donc avant de regarder ton nouveau fichier
Voici ma proposition pour la procédure évènementielle.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([C3:L4], Target) Is Nothing Then
Call Compter_Couleurs
End If
End Sub

D’accord c’est une nouvelle macro faut faire sa ? En tout cas merci tu t’y connais vraiment bien je trouve

 

[Staple1600]

Re

Le truc à modifier, tu peux le faire by yourself
Il suffisait de modifier ainsi cette ligne
Const Lignes = "12/15/18/21/22/25/26"