Optimisation du code

[yoyobat]

Bonjour le forum,

J'ai crée un code qui me permet:

- de colorier une cellule en orange si elle se trouve à l'intersection d'une ligne et d'une colonne contenant la même valeur
- si ce n'est pas le cas, la case reste en blanc.

Malheureusement ce code est beaucoup trop long à s'exécuter malgré les screenupdating.

Pouvez-vous me donner des pistes pour que j'optimise ce code?

Merci beaucoup

Voici le code:

Private Sub Worksheet_Change(ByVal Target As Range)

ScreenUpdating = False

Dim i As Long
Dim j As Long

For i = 11 To 252
For j = 29 To 500

If Cells(j, 256) = Cells(19, i) Then

Cells(j, i).Interior.Color = RGB(255, 127, 0)

Else: Cells(j, i).Interior.Color = RGB(255, 255, 255)

End If

Next j

Next i

ScreenUpdating = True

End Sub



Yoyobat

PS: je n'arrives pas à mettre en PJ le fichier car il me marque "marque de sécurité manquante"

 

[Guest]

Re : Optimisation du code

Bonjour,

Si j'ai bien compris: colore en orange si la valeur de la cellule est déjà présente dans la colonne OU la ligne.

Une mise en forme conditionnelle le fait très bien:

=OU(NB.SI(A:A;A1)>1;NB.SI(1:1;A1)>1)

A+

 

[yoyobat]

Re : Optimisation du code

Bonjour Hasco,

Oui, mais j'ai déjà 3 conditions de MFC sur ces cellules, c'est pour ça que je voudrais rester en VBA (malgré le très bon My Dear Friend).

Je voudrais juste optimiser ce code qui est long.

Merci de ton aide

A+

Yoyobat

 

[Efgé]

Re : Optimisation du code

Bonjour yoyobat, Bonjour Hasco ,
Juste une idée car je ne suis pas certain de bien comprendre le but du jeu.
L'utilisation d'une Worksheet_Change pour traiter plus de 100 000 cellules ne me parait pas une bonne idée .
Ne peux tu pas ne traiter que la colonne et la ligne de ta cible (Target.row et Target.Column)?
Cordialement

 

[Guest]

Re : Optimisation du code

Re,

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.CountIf(Rows(Target.Row), Target.Value) > 1 Or Application.CountIf(Columns(Target.Column), Target.Value) > 1 Then
        Target.Interior.Color = RGB(255, 127, 0)
    Else
        Target.Interior.Color = RGB(255, 255, 255)
    End If
End Sub

il serait peut-être bien de limiter le calcul à la plage utilisée.

A+

 

[yoyobat]

Re : Optimisation du code

voila j'ai pu mettre le fichier.

Merci de votre aide, malheureusement HASCO, ta solution me colories la cellule de départ.

Je m'expliques donc mieux:

Si la valeur de ma colonne IV (n'importe quelle ligne) est la même que la valeur de la ligne 16, (n'importe quelle colonne) alors je veux que la cellule à l’intersection de cette ligne et de cette colonne soit en orange mais si cela n'est pas le cas qu'elle reste en blanc.

ex: cf. PJ.

Merci beaucoup.

Yoyobat

 

[Efgé]

Re : Optimisation du code

Re
Une proposition:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("IV26:IV500")) Is Nothing Or Target.Count > 1 Then Exit Sub
Range(Cells(Target.Row, 10), Cells(Target.Row, 252)).Interior.Color = RGB(255, 255, 255)
For i = 10 To 252
    If Cells(16, i) = Target.Value Then
        Cells(Target.Row, i).Interior.Color = RGB(255, 127, 0)
        Exit For
    End If
Next i
End Sub

Cordialement

 

[Guest]

Re : Optimisation du code

Re,

Sur changement de la valeur de la cellule:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 And Target.Column >= 11 And Target.Column <= 252 Then
    If Range("IV" & Target.Row) = Cells(16, Target.Column) And Target <> "" Then
        Target.Interior.Color = RGB(255, 127, 0)
    Else
        Target.Interior.ColorIndex = xlColorIndexNone
    End If
End If
End Sub

A+

 

[yoyobat]

Re : Optimisation du code

Merci pour ta proposition Efgé qui marche presque.

Je n'ai pas signaler (erreur de ma part) que mes colonnes ne se trouvaient pas toujours au même endroit.

Mon planning est glissant cad si dans ma date de début de ma première tache je rentre une date, mon planning glisse pour se caler sur cette date.

Mes colonnes n'ont donc plus la même appellation.

Pas très compréhensible tout ça, le mieux est que vous fassiez un essai sur le fichier essai 1 en changeant la date de début de la tache N°1 et vous verrez alors le planning glissé et venir se caler à cette date.

Merci en tout cas pour votre aide.

Yoyobat

 

[yoyobat]

Re : Optimisation du code

C'est bon, le code de Efgé est parfait après adaptation à mon cas. Merci de votre aide. A+

 

[Efgé]

Re : Optimisation du code

Re
Comme j'ai préparé quelque chose, je le poste.
A tester....

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, j&, LstRw&, Rw&, Col&
If Target.Count > 1 Then Exit Sub
LstRw = Cells(Rows.Count, 1).End(xlUp).Row
If Not Intersect(Target, Range("IV26:IV" & LstRw)) Is Nothing Then
    Range(Cells(Target.Row, 11), Cells(Target.Row, 252)).Interior.Color = RGB(255, 255, 255)
    For j = 9 To 252
        If Cells(16, j) = Target.Value Then
            Cells(Target.Row, j).Interior.Color = RGB(255, 127, 0)
            Exit For
        End If
    Next j
End If
If Not Intersect(Target, Range("C26:C" & LstRw)) Is Nothing Then
        Range(Cells(26, 11), Cells(LstRw, 252)).Interior.Color = RGB(255, 255, 255)
        For Rw = 26 To LstRw
            For Col = 11 To 252
                If Cells(16, Col).Value = Cells(Rw, 256).Value Then
                    Cells(Rw, Col).Interior.Color = RGB(255, 127, 0)
                    Exit For
                End If
            Next Col
        Next Rw
End If
End Sub

Cordialement