Bonjour a tous
Casefayere et bien soit
Remplace (rnd*255) par(150+(rnd*155))
Pour les 3 tu n'aura pas de couleur trop foncé
Ensuite c est aussi le reste qui est intéressant
Bonjour a tous
Casefayere et bien soit
Remplace (rnd*255) par(150+(rnd*155))
Pour les 3 tu n'aura pas de couleur trop foncé
Ensuite c est aussi le reste qui est intéressant
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
là, je n'ai plus le temps mais essayerai d'adapter ta proposition au code
Cordialement,
Dom
_____________________________________________
Vous êtes nouveau ? pour baliser votre code, cliquer sur cet exemple : Anomaly
pensez à cliquer sur si votre problème l'est
Par contre, il est désagréable de voir une discussion résolue sans message final du demandeur (satisfaction, désarroi, remerciement, conclusion...)
C'est bien la 1ere fois que je vois un duel interessant sur un de mes posts.
Je vous en suis tout reconnaissant.
Merci a vous deux pour votre aide.
je préfère le terme "duo"C'est bien la 1ere fois que je vois un duel interessant
et puis si t rangeais bien tes aliments au congel, on n'aurait pas besoin de faire cette procédure
Cordialement,
Dom
_____________________________________________
Vous êtes nouveau ? pour baliser votre code, cliquer sur cet exemple : Anomaly
pensez à cliquer sur si votre problème l'est
Par contre, il est désagréable de voir une discussion résolue sans message final du demandeur (satisfaction, désarroi, remerciement, conclusion...)
Je non c'est pas un duel graphychris
Casefayere les couleurs ne vont pas en dessous de rgb(151,151,151 ) dans ma derniere intervention on est donc dans les plus claires cela reduit le nombre de possibilités. Mais on reste a 150puissance3 *150 couleurs ce qui reste assez large en terme de palette couleur
et puis si t rangeais bien tes aliments au congel, on n'aurait pas besoin de faire cette procédure
toutes les mêmes !!!
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Oui effectivement ce n'est pas un duel mais dans le cas precis un BONDUELLE ! ! !
soyons sérieux,
après test, ta proposition me parait impeccable Patrick, j'espère ne pas vexer DeathZarakai
à graphikris
tu peux supprimer le code "couleur" donc dans thisWorkbookdans le code de Feuil1
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3 Private Sub Workbook_Open() demarrage End Subet le code "doublon" à remplacer par celui-ci (je n'ai pas vu de défaut)
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Or Target.Column = 4 Or Target.Column = 7 Or Target.Column = 10 Then Doublon End If End SubPS : pour les tests de couleur, tu peux ajouter une variable, ex
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28 Sub Doublon() Dim mondico As Object, temp As String, lacouleur Dim j As Long Set mondico = CreateObject("Scripting.Dictionary") 'on crée un dictionnaire With Sheets("feuil1") With .Columns("A:K").Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With For j = 1 To 10 Step 3 For i = 2 To .Cells(1, j).End(xlDown).Row 'on parcourt toutes données temp = CStr(.Cells(i, j).Value) If Not mondico.exists(temp) Then mondico.Add temp, .Cells(i, j).Address Else If Not IsNumeric(mondico(temp)) Then ' si ca n'est pas numeric ca veut dire qu'il y a une addresse de cellules puisque lettre et chiffre et le "$" lacouleur = RGB(150 + (Rnd * 255), 150 + (Rnd * 255), 150 + (Rnd * 255)) ' on mixe la lacouleur au hasard Range(mondico(temp)).Interior.Color = lacouleur ' on applique la lacouleur a la cellule dont l'adresse est dans l'item du mondico mondico(temp) = lacouleur ' on remplace l'ancienne adresse dans l'item du mondico par la lacouleur End If .Cells(i, j).Interior.Color = mondico(temp) ' et enfin on applique la lacouleur a l'occurrence en cours avec la lacouleur de l'item mondico correspondant a la valeur de la cellule End If Next i Next j End With Set mondico = Nothing 'on oublie pas de libérer la mémoire End Subet en haut du code ex
Code : Sélectionner tout - Visualiser dans une fenêtre à part plusclair As Integeret remplacer 150 par "plusclair
Code : Sélectionner tout - Visualiser dans une fenêtre à part plusclair = 100'par exemple
Cordialement,
Dom
_____________________________________________
Vous êtes nouveau ? pour baliser votre code, cliquer sur cet exemple : Anomaly
pensez à cliquer sur si votre problème l'est
Par contre, il est désagréable de voir une discussion résolue sans message final du demandeur (satisfaction, désarroi, remerciement, conclusion...)
Je suis pointilleux, je teste
Comment eviter si un produit est en double pour que la couleur des cellules soit blanche ? (parfois ça arrive) - C'est un petit détail que je contourne en remettant un produit en double comme ça la couleur de fond blanche change puis je supprime ce rajout de produit afin que les fonds blancs des pdts en double changent de couleurs
Sinon il arrive que 2 pdts en double aient la meme couleur (c'est génant)
Lorsque je rajoute un produit pour que la liste se remette dans l'ordre alphabetique dans le bac concerné sans que j'ai besoin de relancer Excel afin que cela se fasse, j'ai modifié l'execution comme ceci :
Dans feuil 1
Dans Thisworkbook
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Or Target.Column = 4 Or Target.Column = 7 Or Target.Column = 10 Then Doublon End If With ActiveWorkbook.Worksheets("Feuil2").ListObjects("Tableau1").Sort .SortFields. _ Clear .SortFields. _ Add Key:=Range("A2"), SortOn:=xlSortOnValues, Order:=xlAscending, _ DataOption:=xlSortNormal .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With With Sheets("Feuil1") For i = 1 To 10 Step 3 Set Dcel = .Cells(.Rows.Count, i).End(xlUp) Set Plage = .Range(.Cells(1, i), Dcel(1, 2)) Plage.Sort Key1:=.Cells(1, i), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Next End With End Sub
Dans module 1
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21 Private Sub Workbook_Open() Sheets("Feuil2").Select Range("Tableau1[[#All],[Colonne1]]").Select Range("A73").Activate ActiveWorkbook.Worksheets("Feuil2").ListObjects("Tableau1").Sort.SortFields. _ Clear ActiveWorkbook.Worksheets("Feuil2").ListObjects("Tableau1").Sort.SortFields. _ Add Key:=Range("Tableau1[Colonne1]"), SortOn:=xlSortOnValues, Order:= _ xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Feuil2").ListObjects("Tableau1").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Sheets("Feuil1").Select demarrage End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48 Public Dcel As Range, Plage As Range, Cel As Range, i As Long Sub demarrage() Doublon End Sub Sub couleur() 'à toi de voir la valeur de TintAndShade 'à toi de voir les valeurs de y et z Dim y As Long, z As Long y = 5000000 z = 500000 With Sheets("Feuil2") For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row .Range("A" & i).Interior.Color = y .Range("A" & i).Interior.TintAndShade = 0.7 y = y + z Next End With End Sub Sub Doublon() Dim mondico As Object, temp As String, lacouleur Dim j As Long Set mondico = CreateObject("Scripting.Dictionary") 'on crée un dictionnaire With Sheets("feuil1") With .Columns("A:K").Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With For j = 1 To 10 Step 3 For i = 2 To .Cells(1, j).End(xlDown).Row 'on parcourt toutes données temp = CStr(.Cells(i, j).Value) If Not mondico.exists(temp) Then mondico.Add temp, .Cells(i, j).Address Else If Not IsNumeric(mondico(temp)) Then ' si ca n'est pas numeric ca veut dire qu'il y a une addresse de cellules puisque lettre et chiffre et le "$" lacouleur = RGB(150 + (Rnd * 255), 150 + (Rnd * 255), 150 + (Rnd * 255)) ' on mixe la la couleur au hasard Range(mondico(temp)).Interior.Color = lacouleur ' on applique la la couleur a la cellule dont l'adresse est dans l'item du mondico mondico(temp) = lacouleur ' on remplace l'ancienne adresse dans l'item du mondico par la la couleur End If .Cells(i, j).Interior.Color = mondico(temp) ' et enfin on applique la la couleur a l'occurrence en cours avec la la couleur de l'item mondico correspondant a la valeur de la cellule End If Next i Next j End With Set mondico = Nothing 'on oublie pas de libérer la mémoire End Sub
re
tiens teste ca pour tes doublons
le must pour la non monotonie c'est qu'a chaque fois que tu lancera la sub les couleurs changent mais identifie toujours les doublons
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22 Sub Doublon() Randomize Dim mondico As Object, temp As String Dim j As Long, incr As Long Set mondico = CreateObject("Scripting.Dictionary") 'on crée un dictionnaire incr = 3 For j = 1 To 10 Step 3 For i = 2 To Cells(1, j).End(xlDown).Row 'on parcourt toutes données couleur = RGB(255, 255, 255) If Not mondico.exists(Cells(i, j).Value) And Cells(i, j).Value <> "" Then 'si l'ingrédient n'existe pas encore dans le dico c'est qu'on ne l'a jamais croisé donc pas double mondico(Cells(i, j).Value) = "" mondico(Cells(i, j).Value) = Cells(i, j).Address 'on stock l'adresse de la cellule pour la retrouver par la suite Else couleur = Val(RGB(100 + (Rnd * 154), 100 + (Rnd * 154), 100 + (Rnd * 154))) ' on mixe la couleur au hasard Range(mondico(Cells(i, j).Value)).Interior.Color = couleur ' on applique la couleur a la cellule dont l'adresse est dans l'item du dico mondico(Cells(i, j).Value) = couleur ' on remplace l'ancienne adresse dans l'item du dico par la couleur Cells(i, j).Interior.Color = mondico(Cells(i, j).Value) ' et enfin on applique la couleur a l'occurrence en cours avec la couleur de l'item dico correspondant a la valeur de la cellule End If Next i Next j Set mondico = Nothing 'on oublie pas de libérer la mémoire End Sub
c'est fun !!
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
pas obligé, tu relances la macro, c'est pour ça qu'au début je proposai un bouton de commande sur la feuilleC'est un petit détail que je contourne en remettant un produit en double comme ça la couleur de fond blanche change puis je supprime ce rajout de produit afin que les fonds blancs des pdts en double changent de couleurs
à mon avis, la nuance n'est pas visibleSinon il arrive que 2 pdts en double aient la meme couleur (c'est génant)
je viens de t'écrire que tu pouvais supprimer cette macro (si on garde la proposition à Patrick)à Patrick, pas vu ta dernière proposition
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14 Sub couleur() 'à toi de voir la valeur de TintAndShade 'à toi de voir les valeurs de y et z Dim y As Long, z As Long y = 5000000 z = 500000 With Sheets("Feuil2") For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row .Range("A" & i).Interior.Color = y .Range("A" & i).Interior.TintAndShade = 0.7 y = y + z Next End With End Sub
Cordialement,
Dom
_____________________________________________
Vous êtes nouveau ? pour baliser votre code, cliquer sur cet exemple : Anomaly
pensez à cliquer sur si votre problème l'est
Par contre, il est désagréable de voir une discussion résolue sans message final du demandeur (satisfaction, désarroi, remerciement, conclusion...)
re
pour eviter de tomber sur une couleur blanche c'est tres simple
on supprime quelque possibilités en limitant le rgb (pas 255 partout possible )
comme ca on tombera jamais sur rgb(255,255,255)soit blanc
Code : Sélectionner tout - Visualiser dans une fenêtre à part couleur = Val(RGB(100 + (Rnd * 134), 100 + (Rnd * 154), 100 + (Rnd * 124))) ' on mixe la couleur au hasard
@ casefayere tu constatera aussi que comme promis j'utilise une seule variable ("couleur") tout le reste se fait par( i,j ) pour les cellule avec le dico
en terme d'allègement je pense pas que l'on puisse faire plus
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
oui mais du coup ça bug sur la ligne 9 de ton code
Code : Sélectionner tout - Visualiser dans une fenêtre à part couleur = RGB(255, 255, 255)
c'est impossible ca n'a rien a voir
le rgb(255,255,255) est la simplement en cas de non doublons de garder les cellules blanches et en plus c'est avant le changement
peut etre que comme j'ai pas dimer la variable ca plante a cause de ca mais le changement n'a rien a voir
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
je te joins le fichier qui bug.
Lol!!! la bonne blague
tu a une fonction qui porte le même nom que ma variable couleur hihihihi
supprime la sub couleur elle ne te sert plus a rien
et dim la variable couleur dans doublons
voili voilou
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22 Sub Doublon() Randomize Dim mondico As Object, temp As String Dim j As Long, couleur As Long Set mondico = CreateObject("Scripting.Dictionary") 'on crée un dictionnaire incr = 3 For j = 1 To 10 Step 3 For i = 2 To Cells(1, j).End(xlDown).Row 'on parcourt toutes données couleur = RGB(255, 255, 255) If Not mondico.exists(Cells(i, j).Value) And Cells(i, j).Value <> "" Then 'si l'ingrédient n'existe pas encore dans le dico c'est qu'on ne l'a jamais croisé donc pas double mondico(Cells(i, j).Value) = "" mondico(Cells(i, j).Value) = Cells(i, j).Address 'on stock l'adresse de la cellule pour la retrouver par la suite Else couleur = Val(RGB(100 + (Rnd * 134), 100 + (Rnd * 154), 100 + (Rnd * 124))) ' on mixe la couleur au hasard Range(mondico(Cells(i, j).Value)).Interior.Color = couleur ' on applique la couleur a la cellule dont l'adresse est dans l'item du dico mondico(Cells(i, j).Value) = couleur ' on remplace l'ancienne adresse dans l'item du dico par la couleur Cells(i, j).Interior.Color = mondico(Cells(i, j).Value) ' et enfin on applique la couleur a l'occurrence en cours avec la couleur de l'item dico correspondant a la valeur de la cellule End If Next i Next j Set mondico = Nothing 'on oublie pas de libérer la mémoire End Sub
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
ça bug autre part maintenant.
Rajoute "AIL" dans bac 3 puis supprime le.
1 - la couleur reste
2 - erreur sur la ligne
Code : Sélectionner tout - Visualiser dans une fenêtre à part mondico(Cells(i, j).Value) = couleur ' on remplace l'ancienne adresse dans l'item du dico par la couleur
pour le cas ou il y aurait la même bouftifaille dans tes 4 bacs
on teste si l'item de la cle dico est numerique ou pas car je suppose que ton erreur viens de la
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22 Sub Doublon() Dim mondico As Object, temp As String Dim j As Long, couleur As Long Set mondico = CreateObject("Scripting.Dictionary") 'on crée un dictionnaire For j = 1 To 10 Step 3 For i = 2 To Cells(1, j).End(xlDown).Row 'on parcourt toutes données Randomize couleur = RGB(255, 255, 255) If Not mondico.exists(Cells(i, j).Value) And Cells(i, j).Value <> "" Then 'si l'ingrédient n'existe pas encore dans le dico c'est qu'on ne l'a jamais croisé donc pas double mondico.Add (Cells(i, j).Value), Cells(i, j).Address 'on stock l'adresse de la cellule pour la retrouver par la suite Else If Not IsNumeric(mondico(Cells(i, j).Value)) Then couleur = Val(RGB(100 + (Rnd * 154), 100 + (Rnd * 150), 100 + (Rnd * 144))) ' on mixe la couleur au hasard Range(mondico(Cells(i, j).Value)).Interior.Color = couleur ' on applique la couleur a la cellule dont l'adresse est dans l'item du dico mondico(Cells(i, j).Value) = couleur ' on remplace l'ancienne adresse dans l'item du dico par la couleur End If Cells(i, j).Interior.Color = mondico(Cells(i, j).Value) ' et enfin on applique la couleur a l'occurrence en cours avec la couleur de l'item dico correspondant a la valeur de la cellule End If Next i Next j Set mondico = Nothing 'on oublie pas de libérer la mémoire End Sub
re
ben la bonne blague si tu relance pas la sub doublons après avoir modifier une cellule ca va pas le faire tout seul ca n'est pas une mise en forme conditionnelleRajoute "AIL" dans bac 3 puis supprime le.
1 - la couleur reste
2 - erreur sur la ligne
il faut que tu appelle la sub doublon dans le sheets change
allez il faut tout faire ici hein !!!
ajoute cela dans le module thisworkbook
c'est pas compliqué non d'une pipe en bois
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Sh.Name = "Feuil1" And Target.Column Like "[1,4,7,10]" Then Doublon End Sub
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
as tu essayé de rajouter "Tartiflette" dans bac 3 puis de le supprimer ?
regardes, la couleur reste au lieu de redevenir sans fond coloré car y a plus aucun doublon
Si je rajoute un pdt dans bac 3 par exemple mais deja present dans bac 3 (steacks hachés), au lieu qu'Excel le prenne en compte serait il possible d'avoir un msg du style (produit deja present dans ce bac) ?
puré !!
d'apres toi que faudrait -il faire hein!!!???
peut etre ceci
bon allez piece jointe!!
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Sh.Name = "Feuil1" And Target.Column Like "[1,4,7,10]" Then Target.Interior.Color = xlNone: Doublon End Sub
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
le pb reside.
Petit oops de ta part, t'as oublié le code de la feuil1
Sinon un grand merci pour ton aide.
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager