Sujet Précédent Sujet Suivant

VBA - macro

Malliki Messages postés 6 Date d'inscription lundi 26 mars 2007 Statut Membre Dernière intervention 26 mars 2007 - 26 mars 2007 à 09:21
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 - 26 mars 2007 à 22:59
Bonjour !!!


Je suis actuellement entrain de faire une macro sur excel avec l'aide de Visual Basic. Le but de la macro est de colorier l'arrière-plan d'une cellule en fonction de son texte (Ex : si le nom = UBS alors on colorie en jaune etc...). Cette macro fonctionne mais la seule chose que je n'arrive pas, c'est que la macro marche pr la première cellule d'une colonne mais ne va pas à la suivante. Pourriez-vous m'aider svp

mallika

P.S. voici en copie la macro

Application.ScreenUpdating = True
Dim feuille As String


 




Range("B5:B10").Select
         Selection.Copy
    ActiveCell.Offset(0, 9).Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
        True
    ActiveCell.Range("A1:D6").Select
    Selection.Sort Key1:=ActiveCell, Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    ActiveCell.Offset(0, -1).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(RC[3],"" "",RC[4],"" "",RC[1],"" "",RC[2])"
    ActiveCell.Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A6"), Type:= _
        xlFillDefault
    ActiveCell.Range("A1:A6").Select
    Selection.Copy
    ActiveCell.Offset(0, -8).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(0, 8).Range("A1:E6").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveCell.Offset(0, -8).Range("A1:A6").Select
    Selection.Copy
    ActiveCell.Offset(0, 9).Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
        True
       
    For Each x In Range("B")
   
    If ActiveCell = "NOVARTIS" Then
    ActiveCell.Offset(0, -9).Range("A1").Select
    With Selection.Interior
    .ColorIndex = 3
    .Pattern = xlSolid
    End With
    ActiveCell.Offset(0, 9).Range("A1").Select
    Else
    If ActiveCell = "ADECCO" Then
    ActiveCell.Offset(0, -9).Range("A1").Select
    With Selection.Interior
    .ColorIndex = 4
    .Pattern = xlSolid
    End With
    ActiveCell.Offset(0, 9).Range("A1").Select
    Else
    If ActiveCell = "ABB" Then
    ActiveCell.Offset(0, -9).Range("A1").Select
    With Selection.Interior
    .ColorIndex = 32
    .Pattern = xlSolid
    End With
    ActiveCell.Offset(0, 9).Range("A1").Select
    Else
    If ActiveCell = "CREDIT" Then
    ActiveCell.Offset(0, -9).Range("A1").Select
    With Selection.Interior
    .ColorIndex = 16
    .Pattern = xlSolid
    End With
    ActiveCell.Offset(0, 9).Range("A1").Select
    Else
    If ActiveCell = "NESTLE" Then
    ActiveCell.Offset(0, -9).Range("A1").Select
    With Selection.Interior
    .ColorIndex = 23
    .Pattern = xlSolid
    End With
    ActiveCell.Offset(0, 9).Range("A1").Select
    Else
    If ActiveCell = "UBS" Then
    ActiveCell.Offset(0, -9).Range("A1").Select
    With Selection.Interior
    .ColorIndex = 41
    .Pattern = xlSolid
    End With
    ActiveCell.Offset(0, 9).Range("A1").Select
    Else
    End If
    End If
    End If
    End If
    End If
    End If
   
    Next
  
   Range("K5:N10").Select
    Selection.ClearContents
    Selection.Interior.ColorIndex = xlNone


End Sub

3 réponses

Réponse 1 / 3
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
26 mars 2007 à 11:15
Tu y est presque, je pense
Il te faudrait déclarer un "range" valide plutôt que
    For Each x In Range("B")
Tu pourrais sélectionner une plage et utiliser le mot Selection
    For Each x in Selection

t'assurer que c'est bien le texte que tu veux lire  
    If ActiveCell.Text = "NOVARTIS" Then

Ici, tu mets des 9 et des -9 selon le texte... est-ce bien cela que tu veux ?
    ActiveCell.Offset(0, -9).Range("A1").Select
Si oui, tu dois t'assurer de connaître la colonne où est inscrit le texte pour éviter d'aller mettre de la couleur dans une colonne inexistante comme -9 si tu cherches en A ou B ...

MPi
0
Réponse 2 / 3
Malliki Messages postés 6 Date d'inscription lundi 26 mars 2007 Statut Membre Dernière intervention 26 mars 2007
26 mars 2007 à 12:38
en fait ce ki foire c est qu'il exécute la macro juste pr une cellule et que j'aimerais qu'une fois la première cellule remplie par une couleur il passe à la cellule d'en dessous et qu'une fois la colonne terminée il passe à celle d apres ??

est ce que tu aurais une solution ??

Merci bcp en tt cas


 
0
Réponse 3 / 3
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
26 mars 2007 à 22:59
Pour la partie coloration, voici comment je procéderais

Sub Couleur()
    Dim I As Long, nbLignes As Long
   
    'Détermine le nombre de lignes
    nbLignes = Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
   
    For I = 1 To nbLignes
        Select Case Range("B" & I)
            Case "NOVARTIS"
                Range("B" & I).Interior.ColorIndex = 3
                Range("B" & I).Interior.Pattern = xlSolid
            Case "ADECCO"
                Range("B" & I).Interior.ColorIndex = 4
                Range("B" & I).Interior.Pattern = xlSolid
            Case "ABB"
                Range("B" & I).Interior.ColorIndex = 32
                Range("B" & I).Interior.Pattern = xlSolid
            Case "CREDIT"
                Range("B" & I).Interior.ColorIndex = 16
                Range("B" & I).Interior.Pattern = xlSolid
            Case "NESTLE"
                Range("B" & I).Interior.ColorIndex = 23
                Range("B" & I).Interior.Pattern = xlSolid
            Case "UBS"
                Range("B" & I).Interior.ColorIndex = 41
                Range("B" & I).Interior.Pattern = xlSolid
        End Select
    Next
End Sub

MPi
0

Discussions similaires

Comment fonctionne la fonction FormulaR1C1
cs_razmokets -
wape -

2 réponses
fonction modulo en VBA
krisprolss -
Benouille -

2 réponses
Dernière cellule non vide d'une colonne
cs_falafala -
Luigi13013 -

5 réponses
A quoi sert la fonction Set ?
ICIoBRa -
ICIoBRa -

3 réponses
Le Modulo en VB6
elkasmi_ahmed -
econs -

2 réponses
Rejoignez-nous