Boucle imbriquée

[Patchi06]

Bonjour.
Je voudrais affecter une valeur en fonction de la couleur d'une cellule.
J'ai tenté plusieurs version mais sans résultat. Je poste ce bout de code qui ne ressemble à rien mais qui résume la question :
Sur un tableau j'ai une succession de lignes représentant des fiches
Pour chaque famille, j'ai plusieurs sous-famille et un certain nombre de produits. Je n'ai qu'un seul repère visuel : la couleur du fond.
Pour me permettre l'utilisation des filtres, j'aimerais pouvoir inscrire en regard de chaque ligne (sur la 15ème colonne) le type de ligne
J'espère avoir été clair.

For Each Cell In Range("A2:A" & Range("A65536").End(xlUp).Row).Select
If Selection.Interior.ColorIndex = 6 Then Cell.Cells(1, 15).Formula = "FAM"
If Selection.Interior.ColorIndex = 34 Then Cell.Cells(1, 15).Formula = "SFA"
If Selection.Interior.ColorIndex = xlNone Then Cell.Cells(1, 15).Formula = "PRO"
Next Cell

Merci de votre aide.

 

[Pierrot93]

Re : Boucle imbriquée

Bonjour,

essaye peut être ceci :

Option Explicit
Sub test()
Dim Cell As Range
For Each Cell In Range("A2:A" & Range("A65536").End(xlUp).Row)
If Cell.Interior.ColorIndex = 6 Then
    Cell.Offset(0, 14).Value = "FAM"
    ElseIf Cell.Interior.ColorIndex = 34 Then Cell.Offset(0, 14).Value = "SFA"
    ElseIf Cell.Interior.ColorIndex = xlNone Then Cell.Offset(0, 14).Value = "PRO"
End If
Next Cell
End Sub

bon après midi
@+

 

[roro69]

Re : Boucle imbriquée

bonjour
a essayer

Sub Bouton1_QuandClic()

Dim Rgcouleur As Range
Dim Cel As Range
Set Rgcouleur = Range("a1", Range("a65536").End(xlUp))

For Each Cel In Rgcouleur
If Cel Is Nothing Then Exit Sub
If Cel.Interior.ColorIndex=6 then Cel.Offset(0, 14)="FAM"
If Cel.Interior.ColorIndex=34 then Cel.Offset(0, 14)="SFA"
If Cel.Interior.ColorIndex=xlNone then Cel.Offset(0, 14)="PRO"

Next Cel


End Sub

A++

 

[Dull]

Re : Boucle imbriquée

Salut Patchi06, le Forum

Pas sur d'avoir compris

en suivant ton Code d'origine il devrait s'écrire comme cela

Sub ESSai()
Dim C As Range

For Each C In Range("A2:A" & Range("A65536").End(xlUp).Row)
    If C.Interior.ColorIndex = 6 Then C.Offset(1, 15).Formula = "FAM"
    If C.Interior.ColorIndex = 34 Then C.Offset(1, 15).Formula = "SFA"
    If C.Interior.ColorIndex = xlNone Then C.Offset(1, 15).Formula = "PRO"
Next C
End Sub

mais sans fichier et sans plus de précisions

EDITION: Re Pierrot, Roro

Bonne Journée

 

[Patchi06]

Re : Boucle imbriquée

Ca Marche impeccable. !Merci Dull.