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 :

[problème optimisation] Colorier lignes


Sujet :

Macros et VBA Excel

  1. #1
    Membre confirmé
    Profil pro
    Responsable de projet
    Inscrit en
    Décembre 2005
    Messages
    97
    Détails du profil
    Informations personnelles :
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Responsable de projet

    Informations forums :
    Inscription : Décembre 2005
    Messages : 97
    Par défaut [problème optimisation] Colorier lignes
    Bonjour,

    Je souhaite griser les lignes qui contiennent le meme numéro de facture (soit la meme valeur dans la colonne Z).

    J'ai globalement réussie a faire ce que je souhaitais seulement pour plus de 34 000 enregistrement mon code fait planter Excel.

    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
    49
    50
    51
    52
     
    Sub test()
     
        Dim state As Boolean
        Dim lastColo As Integer
        Dim nbLigne As Long
        Dim nbColonne As Long
     
        'nbLigne = Range("B65536").End(xlUp).Row
        'nbColonne = Cells(1, Columns.Count).End(xlToLeft).Column
     
        'nbLigne = 1000
        'nbColonne = 96
     
        'MsgBox nbColonne
     
        state = False
        lastColor = 15
     
        For i = 1 To nbLigne
     
            If Range("Z1").Offset(i, 0).Value = Range("Z1").Offset(i + 1, 0).Value Then
     
                For n = 0 To nbColonne
     
                    If state = False And lastColor = 15 Then
                        Range("A1").Offset(i, n).Interior.Color = RGB(200, 200, 200)
                        Range("A1").Offset(i + 1, n).Interior.Color = RGB(200, 200, 200)
                        lastColor = 0
                        state = True
                    ElseIf state = False And lastColor = 0 Then
                        lastColor = 15
                        Range("A1").Offset(i, n).Interior.Color = RGB(200 + lastColor, 200 + lastColor, 200 + lastColor)
                        Range("A1").Offset(i + 1, n).Interior.Color = RGB(200 + lastColor, 200 + lastColor, 200 + lastColor)
                        lastColor = 15
                        state = True
                    Else
                        Range("A1").Offset(i, n).Interior.Color = RGB(200 + lastColor, 200 + lastColor, 200 + lastColor)
                        Range("A1").Offset(i + 1, n).Interior.Color = RGB(200 + lastColor, 200 + lastColor, 200 + lastColor)
                    End If
     
                Next n
     
                state = True
            Else
                state = False
     
            End If
     
        Next i
     
    End Sub
    Avez vous une idée pour optimiser mon code ?

    Merci beaucoup de votre aide

  2. #2
    Membre confirmé
    Profil pro
    Responsable de projet
    Inscrit en
    Décembre 2005
    Messages
    97
    Détails du profil
    Informations personnelles :
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Responsable de projet

    Informations forums :
    Inscription : Décembre 2005
    Messages : 97
    Par défaut
    Aller je m'auto répond, voici une solution qui est plutot rapide pour 34 000 lignes : environs 3 secondes.

    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
     
    Sub regroupLines()
     
        Dim lastColo As Integer
        Dim nbLigne As Long
        Dim nbColonne As Long
        Dim state As Boolean
     
        state = False
        lastColor = 200
     
        nbLigne = Range("B65536").End(xlUp).Row
        nbColonne = Cells(1, Columns.Count).End(xlToLeft).Column
     
        For i = 1 To nbLigne
     
            If Range("Z1").Offset(i, 0).Value = Range("Z1").Offset(i + 1, 0).Value Then
     
                state = False
     
                Range("A1:CR1").Offset(i, 0).Interior.Color = RGB(lastColor, lastColor, lastColor)
                Range("A1:CR1").Offset(i + 1, 0).Interior.Color = RGB(lastColor, lastColor, lastColor)
     
            Else
     
                If state = True Then
     
                    Range("A1:CR1").Offset(i, 0).Interior.Color = RGB(lastColor, lastColor, lastColor)
                    Range("A1:CR1").Offset(i + 1, 0).Interior.Color = RGB(lastColor, lastColor, lastColor)
     
                End If
     
                state = True
     
                If lastColor = 200 Then
                    lastColor = 215
                Else
                    lastColor = 200
                End If
     
            End If
     
        Next i
     
    End Sub

  3. #3
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Bonjour
    Une 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
    15
    16
    17
    Sub Test()
    Dim nbLigne As Long, i As Long, Clr As Long
    Dim State As Boolean
    Dim Plage As Range
     
    Application.ScreenUpdating = False
    With Worksheets("Feuil1")                                  'A ADAPTER AU NOM DE TA FEUILLE
        Set Plage = .UsedRange
        nbLigne = Plage.Rows.Count
        For i = 1 To nbLigne - 1
            If .Range("Z" & i) <> .Range("Z" & i + 1) Then State = Not State
            Clr = 200 - 15 * State
            Intersect(Plage, .Rows(i + 1)).Interior.Color = RGB(Clr, Clr, Clr)
        Next i
        Set Plage = Nothing
    End With
    End Sub

  4. #4
    Membre confirmé
    Profil pro
    Responsable de projet
    Inscrit en
    Décembre 2005
    Messages
    97
    Détails du profil
    Informations personnelles :
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Responsable de projet

    Informations forums :
    Inscription : Décembre 2005
    Messages : 97
    Par défaut
    Ok je rivalise pas, ton code est carrément plus light pour un résultat performant.

    Un grand merci

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. colorier ligne dans un TRichEdit
    Par didi59650 dans le forum Composants VCL
    Réponses: 7
    Dernier message: 14/04/2006, 13h10
  2. Problème retour à la ligne dans formulaire
    Par Mysti¢ dans le forum Langage
    Réponses: 1
    Dernier message: 03/04/2006, 13h34
  3. [Tableaux] Problème saut de ligne
    Par @lexx dans le forum Langage
    Réponses: 14
    Dernier message: 26/03/2006, 15h20
  4. Problème saut de ligne dans un tableau
    Par talggir dans le forum Général JavaScript
    Réponses: 8
    Dernier message: 23/11/2005, 15h10
  5. problèmes aide en ligne Delphi 2005
    Par philippe.vernhes dans le forum Delphi .NET
    Réponses: 4
    Dernier message: 25/10/2005, 19h35

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