Discussion :

[graphikris]

Bonjour,

Je cherche à pouvoir trier dans l'ordre alphabétique 4 colonnes (A, D, G, J) tout en gardant les colonnes (B, E, H, K) en relation avec le tri.
Les colonnes C, F, I séparent les 4 blocs.
Comme vous pouvez le constater, il s'agit d'aliments rangés dans un congélateur. Ces aliments sont dans un tableau sur la feuille 2 et sont dans une liste déroulante sur la feuille 1.
De plus le must serait que si un aliment est en doublon dans un ou plusieurs bacs, il doivent tous être d'une couleur (peut importe laquelle) voir la copie écran.
Quelqu'un pourrait il m'aiguiller ?
J'ai déjà mis dans le Workbook Open, un tri de la feuille 2.

[casefayere]

Bonsoir,
pour ton tri

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub tri()
Dim Dcel As Range, Plage As Range, Cel As Range
Dim i As Long
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 Sub

pour les doublons, je n'ai pas le temps, patience ! ou attends la réponse d'un autre membre

[DeathZarakai]

Je m'insère dans la conversation et j'attendrais la réponse d'un autre.

Pour les doublons, pour ma part j'aurais parcouru 2 fois les listes en incrémentant un Dictionnaire au premier passage.
Est-ce une bonne méthode ou il y a mieux / plus rapide?

Si la solution du dictionnaire est bonne je m'engage à la coder pour graphikris

DeathZarakai.

[graphikris]

@ casefayere : Merci c'est génial, ça fonctionne très bien

@ DeathZarakai : Feu patate

Ci joint le fichier, si ça peut t'aider et eviter que tu le refasses

Merci

[DeathZarakai]

Bon déjà ta macro d'ouverture c'est :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Feuill2").Activate

Ensuite en ce qui concerne les doublons, c'est certainement pas la solution la plus élégante mais elle fonctionne en tout cas et est très très rapide d'utilisation.
Pourquoi? On utilise l'objet dictionnaire qui fonctionne sur la même technologie que les bases de données en ce qui concerne la recherche d'un élément (pas une grosse boucle de vérification à chaque fois, on trouve l'élément via sa clé).

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
Sub Doublon()
    Set mondico = CreateObject("Scripting.Dictionary") 'on crée un dictionnaire
    Dim i As Long, j As Long, incr As Long
    Dim temp As String
 
    incr = 3
 
    With Worksheets("Feuil1")
    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 'si l'ingrédient n'existep as encore dans le dico c'est qu'on ne l'a jamais croisé donc pas double
                mondico.Add temp, .Range(Cells(i, j), Cells(i, j)).Address 'on stock l'adresse de la cellule pour la retrouver par la suite
            Else 'ici on croise un doublon
                If .Range(mondico.Item(temp)).Interior.ColorIndex < 0 Then 'si le fond est non remplit le color index est négatif
                    .Range(mondico.Item(temp)).Interior.ColorIndex = incr  ' donc on ajoute une couleur à la dite cellule et l'ancienne croisée
                    .Cells(i, j).Interior.ColorIndex = incr
                    incr = incr + 1
                Else 'ce passage est pour s'il y a triple ou quadru etc conserver la même couleur
                    .Cells(i, j).Interior.ColorIndex = .Range(mondico.Item(temp)).Interior.ColorIndex
                End If
            End If
        Next i
    Next j
    End With
    Set mondico = Nothing 'on oublie pas de libérer la mémoire
End Sub

DeathZarakai

P.S. : Pour la première remarque j'ai pas inspecté tout le code, juste que c'était la première erreur qui est survenue.

[casefayere]

Bonjour,

à DeathZarakai

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Feuill2").Activate

Pour la première remarque j'ai pas inspecté tout le code, juste que c'était la première erreur qui est survenue.

non, pas obligé si le code est placé sur la feuille avec un bouton de commande(par exemple)

[DeathZarakai]

Merci casefayere, tu m'apprends quelque chose (je me suis auto formé donc normal qu'il me manque des infos ^^) mais pour le coup c'était dans Thisworkbook dans l'instruction Open et cela a généré une erreur, c'est pour ça que je l'ai signalé.

DeathZarakai.

[casefayere]

mais pour le coup c'était dans Thisworkbook dans l'instruction Open et cela a généré une erreur, c'est pour ça que je l'ai signalé.

perso je n'ai rien mis dedans, travaillant sur fichier indépendant

à DeathZarakai
j'ai parcouru grossièrement et testé ton code pour les couleurs des doublons et j'ai bien aimé, perso, j'étais en route de me faire ch... donc

[DeathZarakai]

Bah écoute au plaisir.

Je me suis auto formé VBA début Janvier donc je suis toujours en train d'apprendre (pour cela que je viens m'exercer ici). Et depuis que j'ai testé les dico, je suis accro c'est très pratique et tellement plus performant que des boucles de tests.

[casefayere]

Donc par rapport à l'idée d'un bouton sur la feuille, ça pourrait donner ça
le code du bouton appelé "CommandButton1" (au hasard)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub CommandButton1_Click()
tri
End Sub

en tête d'un module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Option Explicit
Dim i As Long

en-dessous, le tri qui appelera ta macro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub tri()
Dim Dcel As Range, Plage As Range
 
For i = 1 To 10 Step 3
  Set Dcel = Cells(Rows.Count, i).End(xlUp)
  Set Plage = Range(Cells(2, i), Dcel(1, 2))
  Plage.Sort Key1:=Cells(2, i), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Next
Doublon
End Sub

et ton code, j'ai enlevé le "With" devenu inutile

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
Sub Doublon()
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
    temp = CStr(Cells(i, j).Value)
    If Not mondico.Exists(temp) 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 temp, Range(Cells(i, j), Cells(i, j)).Address 'on stock l'adresse de la cellule pour la retrouver par la suite
    Else 'ici on croise un doublon
      If Range(mondico.Item(temp)).Interior.ColorIndex < 0 Then 'si le fond est non rempli le colorindex est négatif
        Range(mondico.Item(temp)).Interior.ColorIndex = incr  ' donc on ajoute une couleur à la dite cellule et l'ancienne croisée
        Cells(i, j).Interior.ColorIndex = incr
        incr = incr + 1
      Else 'ce passage est pour s'il y a triple ou quadru etc conserver la même couleur
        Cells(i, j).Interior.ColorIndex = Range(mondico.Item(temp)).Interior.ColorIndex
      End If
    End If
  Next i
Next j
Set mondico = Nothing 'on oublie pas de libérer la mémoire
End Sub

[graphikris]

Bonjour et merci a vous 2

Je viens de faire un test et il y a des petits soucis.
1 - Si je rajoute par exemple "Ail (sachet ouvert)" dans le bac 3 et que ce meme produit est deja present dans le bac haut, les cellules de ces deux produits se colorient bien mais parfois avec une couleur deja existante d'un autre produit lui aussi en double (ex : Gambas).

2 - Si je supprime un produit en double (donc cellules colorées) la cellule du produit restant reste colorée.

y a t'il une solution a ces deux petits soucis ?

Merci

[casefayere]

2 - Si je supprime un produit en double (donc cellules colorées) la cellule du produit restant reste colorée.

plus évident à régler que le premier souci, il suffit de supprimer par macro toutes les couleurs et relancer les autres macros mais j'y regarderai de plus près dès que j'aurai du temps

[graphikris]

Ok merci pour ton aide.

Petite idée mais peut etre pas realisable.
Si sur ma liste (feuille 2) je colorie les cellules (1 couleur differente par produit), pourrais t'on reprendre cette couleur lorsqu'il y aura doublon ?

[casefayere]

Si sur ma liste (feuille 2) je colorie les cellules (1 couleur differente par produit), pourrais t'on reprendre cette couleur lorsqu'il y aura doublon ?

c'est à étudier en passant par "Interior.color" et non "colorindex" si tu possède un grand nombre d'articles

essayes ce code dans un module, tu pourras changer les valeurs de "y" et de l'incrémentation "z" comme tu veux, tu vas t'apercevoir que ce n'est pas évident pour les couleurs

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub couleur()
Dim y As Long, i As Long, z As Long
y = 10000000
z = 500000
With Sheets("Feuil2")
  For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A" & i).Interior.Color = y
    y = y + z
  Next
End With
End Sub

[patricktoulon]

bonjour
pour avoir plus de couleur dispo
vous pourriez créer la couleur avec un RND sur RGB
exemple dans votre boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
couleur = RGB((Rnd * 255), (Rnd * 255), (Rnd * 255))
MsgBox round(couleur)

si la bouff exists dans le dico et que l'item dico a une couleur alors mettre la couleur sur la cells(i,j) sinon
mettre l'adresse cellule dans l'item de la cle dico cell
ainsi si on a une adresse dans l'item dico faire rnd rgb puis colorier la cell addres de l'item puis la cells (i,j)
et enfin mettre la couleur dans l'item dicocell
ainsi si ca axist et l'item n'est pas numerique alors créer la couleur et colorier la cell(dico...)et le cell (i,j)
ca fait peter toutes vos variable qui deviennent alors inutiles

vous avez 255 puissance 3 couleurs puissance 255 dispos

[casefayere]

Bonsoir Patrick,

ok mais pour moi tout ça reste aléatoire car si on se retrouve avec une couleur très foncée qui ne permet pas de lire la cellule......!

Bonne soirée

je viens d'essayer ces codes, supprimes tous les autres
code sur feuill1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
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
  couleur
  Doublon
End If
End Sub

code sur ThisWorkbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub Workbook_Open()
couleur
demarrage
End Sub

codes sur un module

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
Public Dcel As Range, Plage As Range, Cel As Range, i As Long
Sub demarrage()
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
Doublon
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
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

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
Sub Doublon()
Dim mondico As Object, temp As String
Dim j As Long, Incr As Range
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 '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 temp, .Range(.Cells(i, j), .Cells(i, j)).Address 'on stock l'adresse de la cellule pour la retrouver par la suite
      Else 'ici on croise un doublon
        If .Range(mondico.Item(temp)).Interior.ColorIndex < 0 Then 'si le fond est non rempli le colorindex est négatif
          Set Incr = Sheets("Feuil2").Range("A2", Sheets("Feuil2").Cells(Sheets("Feuil2").Rows.Count, 1).End(xlUp)).Find(.Range(mondico.Item(temp)))
          .Range(mondico.Item(temp)).Interior.Color = Incr.Interior.Color  ' donc on ajoute une couleur à la dite cellule et l'ancienne croisée
          .Cells(i, j).Interior.Color = Incr.Interior.Color
        Else 'ce passage est pour s'il y a triple ou quadru etc conserver la même couleur
          .Cells(i, j).Interior.ColorIndex = .Range(mondico.Item(temp)).Interior.Color
        End If
      End If
    Next i
  Next j
End With
Set mondico = Nothing 'on oublie pas de libérer la mémoire
End Sub

[patricktoulon]

Bonsoir case fayere

c'est justement ce que j'indiquais que l'on pouvais éviter

quand tu commence ta boucle toutes tes cellules sont sensées être blanches

et donc toi tu es obligé de faire un find pour te rappeler la couleur de l'existence
hors je disais tout simplement de mettre l'adresse de la cellules si la bouff n'existe pas dans l'item et remplacer cette adresse des la prochaine occurrence par le choix d'une couleur au hasard
exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
if not dico.exists(cells(x,y)) then 
dico.add cells(x,y).value,cells(x,y).address
else 
 
if not isnumeric(dico(cells(x,y))) then ' si ca n'est pas numeric ca veut dire qu'il y a une addresse de cellules puisque lettre et chiffre et le "$"
couleur=rgb((rnd*255),(rnd*255),(rnd*255))' on mixe la couleur au hasard 
range(dico(cells(x,y)).interior.color=couleur' on applique la couleur a la cellule dont l'adresse est dans l'item du dico 
 
dico(cells(x,y))=couleur' on remplace l'ancienne adresse dans l'item du dico par la couleur 
end if 
 
cells(x,y).interior.color=dico(cells(x,y))' 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

il n'est pas nécessaire de faire un find car si elle n'existe pas c'est l'address dans l'item sinon on récupère l adress de la précédente occurrence dans l'item du dico et on applique la couleur a la précédente et la nouvelle occurrence et ainsi de suite

comme tu peux le voir seul le dico et une variable long("couleur") est nécessaire

j'espère que c'est plus clair

[graphikris]

@casefayere

Je viens de tester les nouveaux codes. C'est magnifique mais j'ai découvert un bug .
Prenons le cas des Lardons qui sont présents dans les bacs 2 et 3. Si je rajoute des lardons dans le Bac Haut, les lardons du Bac 3 disparaissent et il y a un msg d'erreur :

Erreur d'exécution'9' L'indice n'appartient pas à la sélection

Est ce dû au fait que la couleur d'écriture soit blanche et lorsque je rajoute dans le bac haut, elle soit noire ?

[casefayere]

Bonjour le forum, graphikris , Patrick
je comprends bien ton idée, Patrick, qui pourrait éviter d'affecter une couleur à chaque élément sur la base et d'utiliser "Find", mais les aliments dans le congelé existeront bien car à mon avis ceux-ci auront déjà été enregistrés en feuil2 (base) avant de les intégrer dans le congel (feuil1) qui contient des listes de validation
En retenant ton idée (qui me parait meilleure) afin d'éviter le "Find", les couleurs aléatoires pourraient rendre certaines cellules illisibles, il faudrait donc penser au "TintAndShade " pour éclaircir celles-ci (à mon avis)

j'avoue ne pas avoir encore testé ton code mais en ai compris l'idée, je vais donc le tester de ce pas.

bonne journée

je n'avais pas vu ton post, graphikris, je vais donc tester également car cette erreur m'étonne

à plus

[graphikris]

Je te remercie beaucoup casefayere car ce post pourra également servir pour d'autres idées autres que le congélateur.
Cette idée m'est venue à partir du moment où j'achetais des produits alors qu'ils etaient présents dans mon congel.