IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Tri Aphabétique sur 4 colonnes [XL-2010]


Sujet :

Macros et VBA Excel

  1. #21
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut Re
    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

  2. #22
    Expert éminent Avatar de casefayere
    Homme Profil pro
    RETRAITE
    Inscrit en
    Décembre 2006
    Messages
    5 138
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : RETRAITE
    Secteur : Agroalimentaire - Agriculture

    Informations forums :
    Inscription : Décembre 2006
    Messages : 5 138
    Points : 9 548
    Points
    9 548
    Par défaut
    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...)

  3. #23
    Membre confirmé Avatar de graphikris
    Homme Profil pro
    Pas tres doué
    Inscrit en
    Décembre 2012
    Messages
    1 214
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Pas tres doué
    Secteur : Conseil

    Informations forums :
    Inscription : Décembre 2012
    Messages : 1 214
    Points : 522
    Points
    522
    Par défaut
    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.

  4. #24
    Expert éminent Avatar de casefayere
    Homme Profil pro
    RETRAITE
    Inscrit en
    Décembre 2006
    Messages
    5 138
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : RETRAITE
    Secteur : Agroalimentaire - Agriculture

    Informations forums :
    Inscription : Décembre 2006
    Messages : 5 138
    Points : 9 548
    Points
    9 548
    Par défaut
    C'est bien la 1ere fois que je vois un duel interessant
    je préfère le terme "duo"
    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...)

  5. #25
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut
    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

  6. #26
    Membre confirmé Avatar de graphikris
    Homme Profil pro
    Pas tres doué
    Inscrit en
    Décembre 2012
    Messages
    1 214
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Pas tres doué
    Secteur : Conseil

    Informations forums :
    Inscription : Décembre 2012
    Messages : 1 214
    Points : 522
    Points
    522
    Par défaut
    Oui effectivement ce n'est pas un duel mais dans le cas precis un BONDUELLE ! ! !

  7. #27
    Expert éminent Avatar de casefayere
    Homme Profil pro
    RETRAITE
    Inscrit en
    Décembre 2006
    Messages
    5 138
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : RETRAITE
    Secteur : Agroalimentaire - Agriculture

    Informations forums :
    Inscription : Décembre 2006
    Messages : 5 138
    Points : 9 548
    Points
    9 548
    Par défaut
    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 thisWorkbook
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    Private Sub Workbook_Open()
    demarrage
    End Sub
    dans le code de Feuil1
    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 Sub
    et 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
    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 Sub
    PS : pour les tests de couleur, tu peux ajouter une variable, ex et en haut du code ex
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    plusclair = 100'par exemple
    et remplacer 150 par "plusclair
    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...)

  8. #28
    Membre confirmé Avatar de graphikris
    Homme Profil pro
    Pas tres doué
    Inscrit en
    Décembre 2012
    Messages
    1 214
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Pas tres doué
    Secteur : Conseil

    Informations forums :
    Inscription : Décembre 2012
    Messages : 1 214
    Points : 522
    Points
    522
    Par défaut
    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
    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 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
    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
    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
    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

  9. #29
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut re
    re
    tiens teste ca pour tes 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
    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
    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

  10. #30
    Expert éminent Avatar de casefayere
    Homme Profil pro
    RETRAITE
    Inscrit en
    Décembre 2006
    Messages
    5 138
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : RETRAITE
    Secteur : Agroalimentaire - Agriculture

    Informations forums :
    Inscription : Décembre 2006
    Messages : 5 138
    Points : 9 548
    Points
    9 548
    Par défaut
    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
    pas obligé, tu relances la macro, c'est pour ça qu'au début je proposai un bouton de commande sur la feuille
    Sinon il arrive que 2 pdts en double aient la meme couleur (c'est génant)
    à mon avis, la nuance n'est pas visible
    je viens de t'écrire que tu pouvais supprimer cette macro (si on garde la proposition à Patrick)
    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
    à Patrick, pas vu ta dernière proposition
    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...)

  11. #31
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut re
    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 )
    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
    comme ca on tombera jamais sur rgb(255,255,255)soit blanc


    @ 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

  12. #32
    Membre confirmé Avatar de graphikris
    Homme Profil pro
    Pas tres doué
    Inscrit en
    Décembre 2012
    Messages
    1 214
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Pas tres doué
    Secteur : Conseil

    Informations forums :
    Inscription : Décembre 2012
    Messages : 1 214
    Points : 522
    Points
    522
    Par défaut
    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)

  13. #33
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut re
    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
    Images attachées Images attachées  
    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

  14. #34
    Membre confirmé Avatar de graphikris
    Homme Profil pro
    Pas tres doué
    Inscrit en
    Décembre 2012
    Messages
    1 214
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Pas tres doué
    Secteur : Conseil

    Informations forums :
    Inscription : Décembre 2012
    Messages : 1 214
    Points : 522
    Points
    522
    Par défaut
    je te joins le fichier qui bug.
    Fichiers attachés Fichiers attachés

  15. #35
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut re
    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


    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
    voili voilou
    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

  16. #36
    Membre confirmé Avatar de graphikris
    Homme Profil pro
    Pas tres doué
    Inscrit en
    Décembre 2012
    Messages
    1 214
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Pas tres doué
    Secteur : Conseil

    Informations forums :
    Inscription : Décembre 2012
    Messages : 1 214
    Points : 522
    Points
    522
    Par défaut
    ç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

  17. #37
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut
    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
    Rajoute "AIL" dans bac 3 puis supprime le.
    1 - la couleur reste
    2 - erreur sur la ligne
    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 conditionnelle
    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

    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
    c'est pas compliqué non d'une pipe en bois
    Images attachées Images attachées  
    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

  18. #38
    Membre confirmé Avatar de graphikris
    Homme Profil pro
    Pas tres doué
    Inscrit en
    Décembre 2012
    Messages
    1 214
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Pas tres doué
    Secteur : Conseil

    Informations forums :
    Inscription : Décembre 2012
    Messages : 1 214
    Points : 522
    Points
    522
    Par défaut
    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
    Nom : Image1.png
Affichages : 174
Taille : 145,9 Ko

    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) ?

  19. #39
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut re
    puré !!
    d'apres toi que faudrait -il faire hein!!!???
    peut etre ceci
    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
    bon allez piece jointe!!
    Fichiers attachés Fichiers attachés
    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

  20. #40
    Membre confirmé Avatar de graphikris
    Homme Profil pro
    Pas tres doué
    Inscrit en
    Décembre 2012
    Messages
    1 214
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Pas tres doué
    Secteur : Conseil

    Informations forums :
    Inscription : Décembre 2012
    Messages : 1 214
    Points : 522
    Points
    522
    Par défaut
    le pb reside.
    Petit oops de ta part, t'as oublié le code de la feuil1
    Sinon un grand merci pour ton aide.

+ Répondre à la discussion
Cette discussion est résolue.
Page 2 sur 4 PremièrePremière 1234 DernièreDernière

Discussions similaires

  1. Tri Automatique sur plusieurs colonnes
    Par fouinette17 dans le forum Excel
    Réponses: 0
    Dernier message: 20/04/2012, 22h34
  2. [XL-2003] Tri personalisé sur plusieurs colonnes
    Par yorgh1234 dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 14/05/2011, 23h58
  3. Réponses: 2
    Dernier message: 07/12/2010, 16h39
  4. Tri ListView sur une colonne de type List<T>
    Par thelpi dans le forum Windows Presentation Foundation
    Réponses: 1
    Dernier message: 05/01/2010, 17h46
  5. [Tableaux] Tri alphabétique sur des colonnes d'un tableau html
    Par arnaudperfect dans le forum Langage
    Réponses: 1
    Dernier message: 02/04/2007, 16h51

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo