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 :

Simplifier mon code


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Homme Profil pro
    Mécanicien avion
    Inscrit en
    Février 2018
    Messages
    193
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : France, Charente Maritime (Poitou Charente)

    Informations professionnelles :
    Activité : Mécanicien avion

    Informations forums :
    Inscription : Février 2018
    Messages : 193
    Par défaut Simplifier mon code
    Bonjour à tous,

    J'ai déjà réussi un code grâce à votre aide et mes petites connaissance.
    J'aurais voulu savoir s'il était possible de le simplifier ?

    Voici le code :

    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
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
     
    Set ws11 = Sheets("Controle")
    Set plage11 = ws11.Range("A4:A39")
     
        With ws11
    'Changement couleur ligne suivant place
            For Plage = 4 To 39
                If ws11.Range("A" & Plage) = "" Then
                    ws11.Range("A" & Plage).Font.Color = RGB(0, 0, 0)
                    ws11.Range("A" & Plage).Interior.Color = RGB(255, 255, 255)
                    ws11.Range("B" & Plage).Font.Color = RGB(0, 0, 0)
                    ws11.Range("B" & Plage).Interior.Color = RGB(255, 255, 255)
                    ws11.Range("C" & Plage).Font.Color = RGB(0, 0, 0)
                    ws11.Range("C" & Plage).Interior.Color = RGB(255, 255, 255)
                    ws11.Range("D" & Plage).Font.Color = RGB(0, 0, 0)
                    ws11.Range("D" & Plage).Interior.Color = RGB(255, 255, 255)
                ElseIf ws11.Range("D" & Plage) < 0 Then
                    ws11.Range("A" & Plage).Font.Color = RGB(153, 0, 204)
                    ws11.Range("A" & Plage).Interior.Color = RGB(255, 153, 255)
                    ws11.Range("B" & Plage).Font.Color = RGB(153, 0, 204)
                    ws11.Range("B" & Plage).Interior.Color = RGB(255, 153, 255)
                    ws11.Range("C" & Plage).Font.Color = RGB(153, 0, 204)
                    ws11.Range("C" & Plage).Interior.Color = RGB(255, 153, 255)
                    ws11.Range("D" & Plage).Font.Color = RGB(153, 0, 204)
                    ws11.Range("D" & Plage).Interior.Color = RGB(255, 153, 255)
                ElseIf ws11.Range("D" & Plage) = 0 Or ws11.Range("D" & Plage) = "" Then
                    ws11.Range("A" & Plage).Font.Color = RGB(156, 0, 6)
                    ws11.Range("A" & Plage).Interior.Color = RGB(255, 199, 206)
                    ws11.Range("B" & Plage).Font.Color = RGB(0, 0, 0)
                    ws11.Range("B" & Plage).Interior.Color = RGB(255, 255, 255)
                    ws11.Range("C" & Plage).Font.Color = RGB(0, 0, 0)
                    ws11.Range("C" & Plage).Interior.Color = RGB(255, 255, 255)
                    ws11.Range("D" & Plage).Font.Color = RGB(0, 0, 0)
                    ws11.Range("D" & Plage).Interior.Color = RGB(255, 255, 255)
                Else
                    ws11.Range("A" & Plage).Font.Color = RGB(0, 97, 0)
                    ws11.Range("A" & Plage).Interior.Color = RGB(198, 239, 206)
                    ws11.Range("B" & Plage).Font.Color = RGB(0, 0, 0)
                    ws11.Range("B" & Plage).Interior.Color = RGB(255, 255, 255)
                    ws11.Range("C" & Plage).Font.Color = RGB(0, 0, 0)
                    ws11.Range("C" & Plage).Interior.Color = RGB(255, 255, 255)
                    ws11.Range("D" & Plage).Font.Color = RGB(0, 0, 0)
                    ws11.Range("D" & Plage).Interior.Color = RGB(255, 255, 255)
                End If
            Next Plage
     
     
    'Changement couleur ligne suivant age et apte
            For Plage = 4 To 27
                If ws11.Range("G" & Plage) = "" Then
                    ws11.Range("G" & Plage).Font.Color = RGB(0, 0, 0)
                    ws11.Range("G" & Plage).Interior.Color = RGB(255, 255, 255)
                ElseIf ws11.Range("G" & Plage) <= 17 Then
                    ws11.Range("G" & Plage).Font.Color = RGB(156, 0, 6)
                    ws11.Range("G" & Plage).Interior.Color = RGB(255, 199, 206)
                Else
                    ws11.Range("G" & Plage).Font.Color = RGB(0, 97, 0)
                    ws11.Range("G" & Plage).Interior.Color = RGB(198, 239, 206)
                End If
     
                If ws11.Range("F" & Plage) = "" Then
                    ws11.Range("H" & Plage).Font.Color = RGB(0, 0, 0)
                    ws11.Range("H" & Plage).Interior.Color = RGB(255, 255, 255)
                ElseIf ws11.Range("H" & Plage) = "" Then
                    ws11.Range("H" & Plage).Font.Color = RGB(156, 0, 6)
                    ws11.Range("H" & Plage).Interior.Color = RGB(255, 199, 206)
                Else
                    ws11.Range("H" & Plage).Font.Color = RGB(0, 97, 0)
                    ws11.Range("H" & Plage).Interior.Color = RGB(198, 239, 206)
                End If
     
     
    'affichage doublon résultat négatif
            matchRow = Application.Match(ws11.Range("J" & Plage).Value, plage11, 0)
            isFound = Not IsError(matchRow)
                If isFound Then
                    isValuePositive = ws11.Range("D" & plage11.Cells(matchRow, 1).Row).Value >= 0
                    isValueRien = ws11.Range("D" & plage11.Cells(matchRow, 1).Row).Value <> ""
                Else
                    isValuePositive = False
                    isValueRien = False
                End If
     
                If (isFound And isValuePositive And isValueRien) Or ws11.Range("J" & Plage) = "" Then
                    ws11.Range("J" & Plage).Font.Color = RGB(0, 0, 0)
                    ws11.Range("J" & Plage).Interior.Color = RGB(255, 255, 255)
                Else
                    ws11.Range("J" & Plage).Font.Color = RGB(153, 0, 204)
                    ws11.Range("J" & Plage).Interior.Color = RGB(255, 153, 255)
                End If
            Next Plage
     
     
            If ws11.Range("D3") < 0 Then
                ws11.Range("D2", "D3").Font.Color = RGB(153, 0, 204)
                ws11.Range("D2", "D3").Interior.Color = RGB(255, 153, 255)
            Else
                ws11.Range("D2", "D3").Font.Color = RGB(0, 0, 0)
                ws11.Range("D2", "D3").Interior.Color = RGB(255, 255, 255)
            End If
        End With
    Merci

  2. #2
    Membre confirmé
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    Juillet 2024
    Messages
    43
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Loiret (Centre)

    Informations professionnelles :
    Activité : Ingénieur développement logiciels
    Secteur : Bâtiment Travaux Publics

    Informations forums :
    Inscription : Juillet 2024
    Messages : 43
    Par défaut
    Bonjour Maxou 10

    Peut-être un peu mais pas beaucoup, une idée par exemple est d'utiliser Resize quand c'est possible
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
                If ws11.Range("A" & plage) = "" Then
                    ws11.Range("A" & plage).Resize(1, 4).Font.Color = RGB(0, 0, 0)
                    ws11.Range("A" & plage).Resize(1, 4).Interior.Color = RGB(255, 255, 255)
                ElseIf ws11.Range("D" & plage) < 0 Then
    A+

  3. #3
    Membre Expert
    Inscrit en
    Décembre 2002
    Messages
    993
    Détails du profil
    Informations forums :
    Inscription : Décembre 2002
    Messages : 993
    Par défaut
    Salut, teste ceci, j'ai simplifié avec la structure Select Case, c'est plus lisible et facile à maintenir. J'ai affecté les couleurs aux variables fontColor et interiorColor, cela évite la répétition des codes rgb et c'est plus lisible.

    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
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    Sub Test()
        Dim ws11 As Worksheet
        Dim plage11 As Range
        Dim Plage As Long
        Dim matchRow As Variant
        Dim isFound As Boolean, isValuePositive As Boolean, isValueRien As Boolean
     
        Set ws11 = Sheets("Controle")
        Set plage11 = ws11.Range("A4:A39")
     
        With ws11
            ' Changement couleur ligne suivant place
            For Plage = 4 To 39
                Dim cellD As Range
                Set cellD = .Range("D" & Plage)
     
                Dim fontColor As Long, interiorColor As Long
     
                Select Case True
                    Case .Range("A" & Plage).Value = ""
                        fontColor = RGB(0, 0, 0)
                        interiorColor = RGB(255, 255, 255)
                    Case cellD.Value < 0
                        fontColor = RGB(153, 0, 204)
                        interiorColor = RGB(255, 153, 255)
                    Case cellD.Value = 0 Or cellD.Value = ""
                        fontColor = RGB(156, 0, 6)
                        interiorColor = RGB(255, 199, 206)
                    Case Else
                        fontColor = RGB(0, 97, 0)
                        interiorColor = RGB(198, 239, 206)
                End Select
     
                ' Appliquer les couleurs sur les colonnes A à D
                .Range("A" & Plage & ":D" & Plage).Font.Color = fontColor
                .Range("A" & Plage).Interior.Color = interiorColor
                .Range("B" & Plage & ":D" & Plage).Interior.Color = RGB(255, 255, 255)
            Next Plage
     
            ' Changement couleur ligne suivant âge et apte
            For Plage = 4 To 27
                ' Colonne G (âge)
                Dim cellG As Range
                Set cellG = .Range("G" & Plage)
     
                Select Case True
                    Case cellG.Value = ""
                        fontColor = RGB(0, 0, 0)
                        interiorColor = RGB(255, 255, 255)
                    Case cellG.Value <= 17
                        fontColor = RGB(156, 0, 6)
                        interiorColor = RGB(255, 199, 206)
                    Case Else
                        fontColor = RGB(0, 97, 0)
                        interiorColor = RGB(198, 239, 206)
                End Select
                cellG.Font.Color = fontColor
                cellG.Interior.Color = interiorColor
     
                ' Colonne H (apte)
                Dim cellH As Range
                Set cellH = .Range("H" & Plage)
     
                Select Case True
                    Case .Range("F" & Plage).Value = "" Or cellH.Value = ""
                        fontColor = RGB(156, 0, 6)
                        interiorColor = RGB(255, 199, 206)
                    Case Else
                        fontColor = RGB(0, 97, 0)
                        interiorColor = RGB(198, 239, 206)
                End Select
                cellH.Font.Color = fontColor
                cellH.Interior.Color = interiorColor
            Next Plage
     
            ' Affichage doublon résultat négatif
            For Plage = 4 To 39
                matchRow = Application.Match(.Range("J" & Plage).Value, plage11, 0)
                isFound = Not IsError(matchRow)
     
                If isFound Then
                    isValuePositive = .Range("D" & plage11.Cells(matchRow, 1).Row).Value >= 0
                    isValueRien = .Range("D" & plage11.Cells(matchRow, 1).Row).Value <> ""
                Else
                    isValuePositive = False
                    isValueRien = False
                End If
     
                If (isFound And isValuePositive And isValueRien) Or .Range("J" & Plage).Value = "" Then
                    fontColor = RGB(0, 0, 0)
                    interiorColor = RGB(255, 255, 255)
                Else
                    fontColor = RGB(153, 0, 204)
                    interiorColor = RGB(255, 153, 255)
                End If
     
                .Range("J" & Plage).Font.Color = fontColor
                .Range("J" & Plage).Interior.Color = interiorColor
            Next Plage
     
            ' Vérification des cellules D2 et D3
            Dim cellD2D3 As Range
            Set cellD2D3 = .Range("D2:D3")
     
            If .Range("D3").Value < 0 Then
                fontColor = RGB(153, 0, 204)
                interiorColor = RGB(255, 153, 255)
            Else
                fontColor = RGB(0, 0, 0)
                interiorColor = RGB(255, 255, 255)
            End If
     
            cellD2D3.Font.Color = fontColor
            cellD2D3.Interior.Color = interiorColor
        End With
    End Sub

  4. #4
    Membre confirmé
    Homme Profil pro
    Mécanicien avion
    Inscrit en
    Février 2018
    Messages
    193
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : France, Charente Maritime (Poitou Charente)

    Informations professionnelles :
    Activité : Mécanicien avion

    Informations forums :
    Inscription : Février 2018
    Messages : 193
    Par défaut
    Impeccable, Cela fonctionne !
    Merci.

    Si je doit appliquer ce code sur plusieurs feuille est possible de simplifier ?
    J'ai fait :

    with ws11
    code
    End with

    with ws12
    code
    End with

    with ws12
    code
    End with

    Merci à vous

  5. #5
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    Janvier 2010
    Messages
    13 166
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : Janvier 2010
    Messages : 13 166
    Billets dans le blog
    53
    Par défaut
    Bonjour,
    Un exemple parmi d'autres
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    Sub t()
      Dim ws11 As Worksheet
      Dim t As Variant
      Dim s As Integer
      t = Array("Feuil1", "Feuil3", "Feuil")
      For s = 0 To UBound(t)
        Set ws11 = ThisWorkbook.Worksheets(t(s))
      Next
      Set ws11 = Nothing
    End Sub
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier

Discussions similaires

  1. [XL-2007] Comment simplifier mon code VBA SVP?
    Par anthooooony dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 20/02/2012, 10h59
  2. [XL-2007] Simplifier mon code ?
    Par hdisnice dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 30/06/2011, 08h44
  3. Comment pourrais-je simplifier mon code
    Par pierrot10 dans le forum jQuery
    Réponses: 1
    Dernier message: 28/08/2010, 09h30
  4. Simplifier mon code
    Par pierre987321 dans le forum Langage
    Réponses: 5
    Dernier message: 07/04/2010, 12h49
  5. Simplifier mon code "Majuscule/Minuscule"
    Par Manou34 dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 24/01/2008, 17h05

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