Si Couleur B4 = 4 alors valeur c4 =1 sinon valeur =0

Bonjour,

Tout et dit dans le titre je souhaite a partir de la couleur d'une cellule avoir une valeur soit 1 soit 0 , j'ai réaliser cette macro mais cela ne fonctionne pas vraiment il me met toute les valeurs a 0 , merci pour tout aide .

Sub Couleur()
If Range("b1:b122").Interior.ColorIndex = 4 Then
Range("C1:c444").Value = 1
Else
Range("c1:c444").Value = 0
End If
End Sub

Bonjour,

Tu dois tester cellule par cellule..

Sub Couleur()
Dim Cel As Range
    For Each Cel In Range("b1:b122")
        If Cel.Interior.ColorIndex = 4 Then
            Cel.Offset(0, 1).Value = 1
        Else
            Cel.Offset(0, 1).Value = 0
        End If
    Next Cel
End Sub

Pour autant que la couleur ne soit pas issue d'une MFC

A+

Sub demarre()

Dim lenom As String 'variable référence produit

'************************************************************************************************************************************
Application.ScreenUpdating = False 'Commande pour désactiver l'affichage en temps réel

'************************************************************************************************************************************
'Lancement de la boite de dialogue Userform1

UserForm1.Show
'************************************************************************************************************************************
'Fonction pour extraire la feuille avec la MTBF pour la fusion plus tard

lenom = Range("H2").Value
Columns("AR").Select
Selection.Copy
Workbooks.Add
Sheets.Select
Columns("B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("A1").Select
Selection.Value = lenom
On Error Resume Next

'************************************************************************************************************************************
'Fonction pour trier la colonne B

Range("B2:B10000").Select
    Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

'************************************************************************************************************************************
'Fonction sauvegarde avec écrasement du fichier si déja éxistant

Application.DisplayAlerts = False 'si fichier déja éxistant on écrase
ActiveWorkbook.SaveAs Filename:="N:\Service RAMS - LCC\DN_Aff\Base de travail REX\Restitution qualité\Fichiers pour  fusionnées\" & lenom & "F.xls"
Application.DisplayAlerts = True  'désactivation de la fonction écraser

End Sub

Sub demasquer()

'Fonctions  Démasquage des colonnes suivantes :

    Columns("A").EntireColumn.Hidden = False
    Columns("E").EntireColumn.Hidden = False
    Columns("G").EntireColumn.Hidden = False
    Columns("Q").EntireColumn.Hidden = False
    Columns("S:Z").EntireColumn.Hidden = False

End Sub
Sub masquer()

'Fonctions  Masquage des colonnes des colonnes suivantes :

    Columns("A").EntireColumn.Hidden = True
    Columns("E").EntireColumn.Hidden = True
    Columns("G").EntireColumn.Hidden = True
    Columns("Q").EntireColumn.Hidden = True
    Columns("S:Z").EntireColumn.Hidden = True

End Sub

Re,

yoyo59 a écrit :

If Cel.Value = "" Then

Value = ""

Tu pourrais me dire à quoi ça sert et Value c'est quoi

Supprime ces deux lignes.. ELLES SERVENT A RIEN

A

salut,

donc cela sert a calculer un chiffre d'affaire a partir de cela je peut faire d'autres calcules plus abouties qu'avec de simple formules d'excel .

si je m'en sert s'il ny'a pas de valeur , car j'ai des lignes qui sont prises en compte et qui n'ont pas de couleurs .

T'est dure à la détente toi, tu veux comprendre ??

Au dessus du module (tout en haut) tu met..

Option explicit

lol , je sais commeme ce que je fait , pour "option explicite" j'ai déjà mit

Ah oui.. dernière intervention, tu est vraiment trop têtu.

Mais j crois que j'ai compris ton problème.

Option Explicit

Sub Couleur()
Dim cel As Range
    For Each cel In Range("b1:b12222")
        If Not IsEmpty(cel) Then
           If cel.Interior.ColorIndex = 4 Then
                cel.Offset(0, 1).Value = 1
            Else
                cel.Offset(0, 1).Value = 0
            End If
        End If
    Next cel
End Sub

lol , je sais commeme ce que je fait , pour "option explicite" j'ai déjà mit

Si tu savais VRAIMENT ce que tu fais je suppose que tu ne poserais pas la question sur un forum ?