MFC par rapport au chiffre contenu dans la cellule d'une colonne

Résolu
agathe182 Messages postés 49 Date d'inscription   Statut Membre Dernière intervention   -  
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

J'essaie d'appliquer une MFC dès lors que les chiffres 1 à 6 se trouvent dans la colonne B de mon tableau. Pour cela, j'ai essayé d'utiliser la fonction .find mais je n'arrive pas à la faire fonctionner... Voici mon code :
Sub MFC_alerts()
' MFC sur les alertes
Dim i As Integer
derniereligne = Range("B50000").End(xlUp).Row
For i = 3 To derniereligne
' Alerte 1
If Range("B" & i).Find("1", Lookat:=xlPart) Then
Range("i26,i27").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 192
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
' Alerte 2
ElseIf Range("i2").Find("2", Lookat:=xlPart) Then
Range("i30").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 192
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
'Alerte 3
ElseIf Range("i2").Find("3", Lookat:=xlPart) Then
Range("i19,i22").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 192
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
'Alerte 4
ElseIf Range("i2").Find("4", Lookat:=xlPart) Then
Range("i37").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 192
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
'Alerte 5
ElseIf Range("i2").Find("5", Lookat:=xlPart) Then
Range("i33").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 192
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
'Alerte 6
ElseIf Range("i2").Find("6", Lookat:=xlPart) Then
Range("i41").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 192
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Else
End If
Next i
End Sub

Des idées ?
Merci par avance pour votre aide :)

A voir également:

3 réponses

f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

Pourquoi du VBA pour ces "MFC" ??
0
agathe182 Messages postés 49 Date d'inscription   Statut Membre Dernière intervention  
 
Parce que je veux pas garder la MFC, mais la mettre que quand je clique sur mon autre macro qui indique les irrégularités sur les données du fichier.
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713 > agathe182 Messages postés 49 Date d'inscription   Statut Membre Dernière intervention  
 
Re,

Parce que je veux pas garder la MFC
Ben, sauf si vous avez un code pour enlever ces"MFC" ou que vous fermiez le fichier sans enregistrer, elles vont rester !!!
0
agathe182 Messages postés 49 Date d'inscription   Statut Membre Dernière intervention  
 
J'ai un code pour les enlever. J'ai juste un problème avec cette ligne
  If Range("B" & i).Find("1", Lookat:=xlPart) Then 
que je n'arrive pas à faire fonctionner. J'imagine que j'ai un problème avec la syntaxe mais je ne sais pas lequel.
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713 > agathe182 Messages postés 49 Date d'inscription   Statut Membre Dernière intervention  
 
Re,

un simple "=" irait parfaitement, .find c'est quand vous cherchez une valeur dans une plage et 1 au lieu de "1" ca devrait aussi le faire
0
agathe182 Messages postés 49 Date d'inscription   Statut Membre Dernière intervention  
 
En fait dans ma cellule où je cherche la valeur 1 il peut aussi y avoir les valeurs 2 à 6. Et chaque valeur envoi à une MFC différente..
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
bonjour
F89 :excuse l'incruste

comme il existe un coce pour enlever ces vraies-fausses MFC
Option Explicit
'--------------------------------------------
Sub vraie_fausse_mfc()
Dim Derlig As Integer, Cptr As Integer, D_mfc As Object, T_colB, Ref As Byte


Application ScreenUpdating = False
Derlig = Columns("B").Find(what:="*", searchdirection:=xlPrevious).Row
Set D_mfc = CreateObject("scripting.dictionnary")
For Cptr = 1 To 6
D_mfc.Add Cptr, ""
Next
T_colB = Application.Transpose(Range("B1:B" & Derlig))

For Cptr = 1 To Derlig
Ref = T_cob(Cptr)
If D_mfc.exists(Ref) Then
Select Case Ref
Case 1
With Range(Cells(26, Cptr), Cells(27, Cptr))
.Interior.Color = 192
.Font.Color = xlThemeColorDark1
End With
Case 2
'.......etc
End Select
End Sub


nota
xlThemeColorDark1 correspond à la couleur par défaut d'excel
0
agathe182 Messages postés 49 Date d'inscription   Statut Membre Dernière intervention  
 
Merci Michel, j'avais déjà le code pour enlever les MFC de ce type mais je te remercie :)
Aucune idée pour mon problème avec la recherche de chiffre dans une cellule ?
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713 > agathe182 Messages postés 49 Date d'inscription   Statut Membre Dernière intervention  
 
Re,

Salut Michel_m, ca flotte??


agathe182
ah ah c'est parce que 30 c'est le numero

Vous pouviez mettre directement "AD" & i, comme tout le monde, ca eviterait les palabres

Je vous modifie le code
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713 > f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention  
 
Re,

Code modifie

Sub MFC_alerts()
    ' MFC sur les alertes
    Dim i As Integer

    derniereligne = Range("B50000").End(xlUp).Row
    For i = 3 To derniereligne
        Alerte = Range("B" & i)
        ' Alerte 1
        '- Si ("B" & i) contient 1 : changer la couleur de i26 et i27 (donc la colonne Z et AA, ligne i)
        If Alerte Like "*1*" Then
            Range("Z" & i & ",AA" & i).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 192
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
        End If
        ' Alerte 2
        '- Si ("B" & i) contient 2 : changer la couleur de i30 (colonne AD, ligne i)
        If Alerte Like "*2*" Then
            Range("AD" & i).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 192
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
        End If
        'Alerte 3
        '- Si ("B" & i) contient 3 : changer la couleur de i19 et i22 (colonne S et V, ligne i)
        If Alerte Like "*3*" Then
            Range("S" & i & ",V" & i).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 192
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
        End If
        'Alerte 4
        '- Si ("B" & i) contient 4 : changer la couleur de i38 (colonne AL, ligne i)
        If Alerte Like "*4*" Then
            Range("AL" & i).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 192
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
        End If
        'Alerte 5
        '- Si ("B" & i) contient 5 : changer la couleur de i35 (Colonne AI, ligne i)
        If Alerte Like "*5*" Then
            Range("AI" & i).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 192
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
        End If
        'Alerte 6
        '- Si ("B" & i) contient 6 : changer la couleur de i43 (colonne AQ, ligne i)
        If Alerte Like "*6*" Then
            Range("AQ" & i).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 192
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
        End If
    Next i
End Sub
0
agathe182 Messages postés 49 Date d'inscription   Statut Membre Dernière intervention  
 
Top ça marche trop bien :)
Merci beaucoup !
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314 > agathe182 Messages postés 49 Date d'inscription   Statut Membre Dernière intervention  
 
et si tu lisais ce que j'avais marqué ?

J'AI FAIS LE CODE SANS TENIR COMPTE DE L4ENLEVEMENT DES MFC PUISQUE TU ECRIS QUE TU L'A FAIT

Inscrite sur ma blacklist --->abandon de toute aide
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Re michel_m,

0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
bof
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713 > michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention  
 
Bonjour,

En français : Bande originale de film, OkAYYYYYYY !!!!!!
0