Tri Aphabétique sur 4 colonnes

**patricktoulon** · 05/05/2016, 12h36

re
autant pour moi
ca enlève bien la couleur de la cellule que tu change mais pas sa jumelle dans les autres bacs
alors on généralise l'opération tout simplement
le principe est simple
1 des le changement d'une cellule on supprime toute couleur
2 doublons refait le boulot
et la on a bien la mise en forme comme si elle était conditionnelle ce qu'elle est d'ailleurs mais par vba

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 Sh.UsedRange.Interior.Color = xlNone: Doublon
End Sub

re

mais entre nous comme ca en passant tu aurais pu faire plus simple
puisque tu a une liste complète en feuille 3
en colonne b pourquoi ne par mettre une couleur au hazard
et quand tu est dans ta boucle dico prendre celle du feuille 3 en B

ca éliminerait le calcul RND pendant l'opération
ce calcul se ferait que lorsque tu ajoute mon dessert

dans la feuille 3

re
c'est bon on a fini??

**patricktoulon** · 05/05/2016, 13h01

allez une petite derniere
comme chez moi ton exemplaire fonctionne enfin
je simplifie la donne
vire tout les code de ton classeur je dis bien tous y compris dans la feuille 1

maintenant
1 met ceci dans le thisworkbook c'est tout !!!!

Code :

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

1
2
3
4
5
6
Private Sub Workbook_Open()
changement
End Sub
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 changement
End Sub

maintenant dans un module standard tu met cela :
Public Dcel As Range, Plage As Range, Cel As Range, i As Long

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 changement()
 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
  Sheets("Feuil1").UsedRange.Interior.Color = xlNone:
  Doublon
 
 
End Sub

et puis ceci aussi

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

et voila
sinon prends ton fichier

**graphikris** · 05/05/2016, 13h09

Je viens juste de voir ton nouveau code et le fichier joint : aucun tri ???? a chaque changement
Non c'est pas fini, ya le digeo

Sinon pour ma question portant sur :
Si je rajoute un produit dans un bac (3 par exemple) et qu'il est déjà présent dans ce bac 3, comment faire pour avoir un message d'alerte me disant : "Ce produit est déjà présent dans ce bac, veuillez juste modifier sa quantité". et ainsi invalider la saisie de ma liste deroulante

**patricktoulon** · 05/05/2016, 13h16

autant pour moi je t'ai donné le mauvais

tiens prends le tiens chez moi ca fonctionne nikel!!

**graphikris** · 05/05/2016, 13h19

nickel c'est impec...

Sinon pour ma question portant sur :
Si je rajoute un produit dans un bac (3 par exemple) et qu'il est déjà présent dans ce bac 3, comment faire pour avoir un message d'alerte me disant : "Ce produit est déjà présent dans ce bac, veuillez juste modifier sa quantité". et ainsi invalider la saisie de ma liste deroulante

**patricktoulon** · 05/05/2016, 13h24

petite correction sur le change
on enlève la quantité aussi !!! quand on vide la ligne

Code :

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

1
2
3
4
5
6
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
If Target = "" Then Target.Offset(0, 1) = ""
changement
End If
End Sub

**graphikris** · 05/05/2016, 13h27

bien vu pour les Qtés

**patricktoulon** · 05/05/2016, 13h28

re
pour ton test sur l'existence dans la même colonne tu pourrais utiliser la fonction match!!! comme ca on boucle pas encore une fois
je te laisse faire tes recherches je reviendrais plus tard je part en inter la !
mais d'abords un café

**graphikris** · 05/05/2016, 14h28

Ok mec je cherche et te tiens au jus.

Alors voila ce que j'ai fait :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
Dim Cible As String
Dim x As Long
 
Cible = "Cives"
 
On Error Resume Next
x = Application.Match(Cible, Worksheets("Feuil1").Columns("A:A"), 0)
 
If x <> 0 Then
    MsgBox "" & Cible & ", existe dèjà dans ce bac. Veuillez juste modifier sa quantité." & Chr(13) & " Voir Ligne " & x & "."
End If
End Sub

Seulement ça ne fonctionne que sur la colonne A et sur le mot "Cives".
Il faudrait que ça puisse fonctionner sur les colonnes (A ou D ou G ou J) et dès que je clique sur un produit de la liste déroulante. Je dis bien OU à propos des colonnes car c'est en fonction de l'endroit où je sélectionnes la liste déroulante

Pas évident (surtout pour moi)

**Philippe Tulliez** · 05/05/2016, 15h15

Bonjour,

Sinon pour ma question portant sur :
Si je rajoute un produit dans un bac (3 par exemple) et qu'il est déjà présent dans ce bac 3, comment faire pour avoir un message d'alerte me disant : "Ce produit est déjà présent dans ce bac, veuillez juste modifier sa quantité". et ainsi invalider la saisie de ma liste deroulante

Je m'incruste dans cette discussion parce-que je me pose la question de savoir pourquoi utiliser une procédure VBA pour vérifier si une valeur ou une référence a déjà été encodée là où l'outil Validation de données suffirait ?

**graphikris** · 05/05/2016, 15h24

Bonjour Philippe,

Comment ça "Inscrutation" ? Pas du tout, au contraire, j'avais déjà un duo de choc, bienvenue au Trio.

Pour moi l'outil "Validation de données" que j'utilise pour sélectionner un produit est là juste pour Sélectionner dans ma liste déroulante nommée "Liste", un produit existant sur la feuille 2. S'il n'existe pas, je le rajoute dans mon [Tableau1] colonne A feuille 2.

Ma question est la suivante : Avoir un msg d'erreur me disant : [nom du produit] sélectionné dans la liste déroulante deja present dans ce bac (s'il est déjà present dans celui ci, sinon aucune info et validation du produit.)
Par contre si ce produit est present dans un autre bac que celui dans lequel je suis alors aucun msg.

**patricktoulon** · 05/05/2016, 15h39

il est vrai que la fonction match nécessite une gestion d'erreur sur plage en cas de non existence ca me plait pas trop
ca m'ennuie d'utiliser un find

cherchons autre chose

a mais je suis bête!!!!! et countiff alors !!!!!! hein

**graphikris** · 05/05/2016, 15h48

si tu le dis alors COUNTIFF
Je ne connais pas cette fonction (je suppose que ça compte Si)

**patricktoulon** · 05/05/2016, 15h50

allez modifie le change et c'est valable pour les 4 colonne sans rien changer!!!!

Code :

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

1
2
3
4
5
6
7
8
9
10
11
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
        nb = WorksheetFunction.CountIf(Range(Cells(1, Target.Column), Cells(Rows.Count, Target.Column).End(xlUp)), Target.Value)
        If nb = 1 Then
            changement
        Else
            MsgBox "t'es miro ou quoi!!!"
            Target = ""
        End If
    End If
End Sub

**graphikris** · 05/05/2016, 15h58

ok ça met bien le msg mais la macro tourne en boucle. Plus moyen de la stopper. Le msg est figé

**Philippe Tulliez** · 05/05/2016, 15h59

Bonjour,

a mais je suis bête!!!!! et countiff alors !!!!!! hein

Et bien oui, c'est la fonction (NB.SI) que j'aurais proposée si l'on utilisait la Validation de données mais effectivement s'il y a une liste déroulante découlant du même outil, le cumul n'est pas possible et c'est une lacune, je trouve.

**patricktoulon** · 05/05/2016, 16h01

et non ca bloque tout on est pas loin

allez cette fois ci c'est la bonne

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
     oldact = Target
    If Sh.Name = "Feuil1" And Target.Column Like "[1,4,7,10]" Then
        nb = WorksheetFunction.CountIf(Range(Cells(1, Target.Column), Cells(Rows.Count, Target.Column).End(xlUp)), Target.Value)
        If nb = 1 Then
         changement
        Else
            If ActiveCell <> "" Then ActiveCell.ClearContents: MsgBox "t'es miro ou quoi!!!" & vbcrlf & " de toute facon y a plus de place   tant qu'il y a toujours la cote de bœuf de Patrick"
             changement
        End If
     End If
End Sub