Macro excel Résolu

Question

Bonjour 

Je suis nouveau et je cherche à faire une macro dans excel mais je ne connais rien...
J'aimerais que la macro mette "--" dans K1 si A1 ="prt" et ainsi de suite pour toute la page... K2= "--" si B2="prt".
Et je ne peux pas utiliser de fomules car je fais des copier coller donc macro obilgatoire...

Et une autre macro me serait utile...

Si B1 est de couleur "4" , D1 doit avoir la même couleur et si B2 est orange, D2 doit être orange...
MErci

jrivet · Accepted Answer

Re,
Non c'est normal.
Car nous gardons en mémoire la couleur (avec MColor)
Il faut donc ajouter au Select Case le Case ELse

Soit:
Private Sub CommandButton1_Click()
Static EnCours As Boolean
   'Pour se protéger de la "récursivité"
   If Not EnCours Then
       EnCours = True
   Else
       Exit Sub
   End If
   Dim MColor As Integer
   Application.ScreenUpdating = False 'Pour désactiver la mise à jour de l'affichage
   
   For Each c In Worksheets(1).Range("b1:b500")
       Select Case c.Value
           Case "prt": MColor = 4
                      Range("K" & c.Row).Value = "--"
           Case "unit": MColor = 6
           Case "ms": MColor = 50
           Case "os": MColor = 38
           Case "ps": MColor = 8
           Case "es": MColor = 45
           Case "obj": MColor = 48
           Case Else: MColor = 0
       End Select
       
       c.Interior.ColorIndex = MColor
       c.Font.ColorIndex = 0       If MColor 0 Then c.Font.Bold False       If MColor 4 Or MColor 45 Then Range("D" & c.Row).Interior.ColorIndex = MColor
   Next c
   
   Application.ScreenUpdating = True
   'petite ligne a rajouter si on veut le faire
   'plus d'une fois
   EnCours = False
End Sub<hr />, ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée

jrivet · Answer

Salut,
A toi de placer le code ou bon te semble
'En regle générale
If Range("A1").Value = "prt" Then Range("K1").Value = "--"
'Sinon dans une boucle
Dim i As Long
For i = 1 To 10
   If Range("A" & CStr(i)).Value = "prt" Then Range("K" & CStr(i)).Value = "--"
Next

'pour la couleur
If Range("B1").Interior.ColorIndex = 4 Then Range("D1").Interior.ColorIndex = 4
'il y a plusieur orange 45 en est un
If Range("B2").Interior.ColorIndex = 45 Then Range("D2").Interior.ColorIndex = 45, ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée

pascal7376 · Answer

Merci pour cett réponse rapide...


Dans mon fichier excel, j'utilise déjà une macro qui fonctionne mais qui est peut-être compliqué....
Et moi j'aimerais rajouter la couleur dans la colonne D et pas seulement la B.
Et si dans la colonne A je trouve "prt" alors mettre "--" dans K (mais pas seulement ligne 1 ou 2 mais faire le controle dans toute la page....)

Un grand merci


Private Sub Worksheet_Change(ByVal Target As Range)
  
  Application.ScreenUpdating = False 'Pour désactiver la mise à jour de l'affichage
  
  For Each c In Worksheets(1).Range("b1:b500")
   
    If c.Value = "prt" Then
        c.Interior.ColorIndex = 4
        c.Font.ColorIndex = 0
    End If
    If c.Value = "unit" Then
        c.Interior.ColorIndex = 6
        c.Font.ColorIndex = 0
    End If
    If c.Value = "ms" Then
        c.Interior.ColorIndex = 50
        c.Font.ColorIndex = 0
    End If
    If c.Value = "os" Then
        c.Interior.ColorIndex = 38
        c.Font.ColorIndex = 0
    End If
    If c.Value = "ps" Then
        c.Interior.ColorIndex = 8
        c.Font.ColorIndex = 0
    End If
    If c.Value = "es" Then
        c.Interior.ColorIndex = 45
        c.Font.ColorIndex = 0
    End If
    If c.Value = "obj" Then
        c.Interior.ColorIndex = 48
        c.Font.ColorIndex = 0
    End If
    If c.Value = "" Then
        c.Interior.ColorIndex = 0
        c.Font.ColorIndex = 0
        c.Font.Bold = False
    End If
   




Next c
Application.ScreenUpdating = True
End Sub

drikce06 · Answer

As tu essayé le code proposé au moins?

 Drikce 06 (Nouveau !!! Forum Exclusivement Office Et VBA By Mortalino)

Si la réponse vous convient: Réponse acceptée < body>

pascal7376 · Answer

Oui mais je connais vraiment pas grand chose donc je ne sais pas trop ou le mettre... puisque j'ai déjà une macro...dsl

pascal7376 · Answer

Oui mais je connais vraiment pas grand chose donc je ne sais pas trop ou le mettre... puisque j'ai déjà une macro...dsl

drikce06 · Answer

Alors déjà dans la macro existantes utilise des elseif ou encore mieux le select case.

 Drikce 06 (Nouveau !!! Forum Exclusivement Office Et VBA By Mortalino)

Si la réponse vous convient: Réponse acceptée < body>

jrivet · Answer

J'espere ne pas avoir tapé trop à coté.

Private Sub Worksheet_Change(ByVal Target As Range)

   Dim MColor As Integer
   Application.ScreenUpdating = False 'Pour désactiver la mise à jour de l'affichage
   
   For Each c In Worksheets(1).Range("b1:b500")
       Select Case c.Value
           Case "prt": MColor = 4
                       Range("K" & c.Row).Value = "--"
           Case "unit": MColor = 6
           Case "ms": MColor = 50
           Case "os": MColor = 38
           Case "ps": MColor = 8
           Case "es": MColor = 45
           Case "obj": MColor = 48
           Case vbNullString: MColor = 0
       End Select
       
       c.Interior.ColorIndex = MColor
       c.Font.ColorIndex = 0       If MColor 0 Then c.Font.Bold False       If MColor 4 Or MColor 45 Then Range("D" & c.Row).Interior.ColorIndex = MColor
   Next c
   Application.ScreenUpdating = True
   

End Sub , ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée

pascal7376 · Answer

Un grand merci
Voius avez réussi à cerner mon problème très rapidement...
Juste un prob j'ai l'impression que la macro tourne en boucle...
C'est peut-être mon fichier excel car j'ai des cellule fussionner et trucs dans le genre...
Comment puis-je vous faire voir mon fichier excel???
Je ne sais pas comment vous remecier

drikce06 · Answer

Et bien réactive la mise à jour de l'écran.

Application.ScreenUpdating = True

 Drikce 06 (Nouveau !!! Forum Exclusivement Office Et VBA By Mortalino)

Si la réponse vous convient: Réponse acceptée < body>

jrivet · Answer

Salut,
NE désactive pas le ScreenUpdating si tu veux faire du pas à pas efficace.

qu'entends exactement par "tourne en boucle"

@+: Ju£i?n
Pensez: Réponse acceptée

pascal7376 · Answer

J'ai exactement mis votre macro qui rempli mes cellules correctement mais la macro tourne toujours et je ne peux plus utiliser excel ....
Puis-je vous envoyer mon fichier xls.

jrivet · Answer

Si tu veux
epsylon9@gmail.com

@+: Ju£i?n
Pensez: Réponse acceptée

pascal7376 · Answer

C'est envoyé....

pascal7376 · Answer

C'est envoyé....

jrivet · Answer

Re,
REcu,
Petite question elle doit se lancer quand exactement cette fameuse macro?
Car la elle à pas l'air de se lancer.

@+: Ju£i?n
Pensez: Réponse acceptée

drikce06 · Answer

Quand la feuille subit un changement à première vu!

 Drikce 06 (Nouveau !!! Forum Exclusivement Office Et VBA By Mortalino)

Si la réponse vous convient: Réponse acceptée < body>

jrivet · Answer

Re,
Bah alors c'est normal que tu crois que la macro de s'arrete pas.
En fait elle s'execute à chaque changement dans la feuille. hors ta macro effectue des changements dans la feuille qui rappelle la même macro, et ainsi de suite.

Donc il faut que tu spécifie peu être mieux le moment où tu souhaite qu'elle sexecute ou alors faire une truc du genre.

Private Sub Worksheet_Change(ByVal Target As Range)
Static EnCours As Boolean
'Pour se protéger de la "récursivité"
    If Not EnCours Then
       EnCours = True
   Else
       Exit Sub
   End If
   Dim MColor As Integer
   Application.ScreenUpdating = False 'Pour désactiver la mise à jour de l'affichage
 
   For Each c In Worksheets(1).Range("b1:b500")
       Select Case c.Value
           Case "prt": MColor = 4
                      Range("K" & c.Row).Value = "--"
           Case "unit": MColor = 6
           Case "ms": MColor = 50
           Case "os": MColor = 38
           Case "ps": MColor = 8
           Case "es": MColor = 45
           Case "obj": MColor = 48
           Case vbNullString: MColor = 0
       End Select
     
       c.Interior.ColorIndex = MColor
       c.Font.ColorIndex = 0       If MColor 0 Then c.Font.Bold False       If MColor 4 Or MColor 45 Then Range("D" & c.Row).Interior.ColorIndex = MColor
   Next c
   
   Application.ScreenUpdating = True
 

End Sub , ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée

pascal7376 · Answer

Ok mais avec la dernière version, elle ne se lance plus... que faut-il faire pour qu'elle se lance

pascal7376 · Answer

Ok mais avec la dernière version, elle ne se lance plus... que faut-il faire pour qu'elle se lance

pascal7376 · Answer

pardon ca marche
Quel bonheur
Un grand merci
Ca ferait du bien d'avoir votre savoir.... et encore merci pour la réponse aussi rapide...

pascal7376 · Answer

Je me suis réjouis trop vite... en faite, je ne sais pas quand est-ce qu'elle se lance???

pascal7376 · Answer

est-ce possible de mettre un icone pour la lancé?

cs_MPi · Answer

Je reviens à ta question initiale dans laquelle tu écris:
Et je ne peux pas utiliser de fomules car je fais des copier coller donc macro obilgatoire...

Je ne vois pas où est le problème de faire des copier-coller avec des formules si tu colles en Valeur (???)

MPi

pascal7376 · Answer

Oui vous avezu certainement raison... je vais essayer.
Comment dois-je faire pour lancer la macro???? Avec un icône??

jrivet · Answer

Salut,
Pourquoi ne pas ajouter un bouton qur ta feuille excel?
Ca t'irais?

Et ensuite tu place tout le code qui était dans _Change dans l'événement ClicK.

En fait je me suis rendu compte que la macro d'hier ne s'executait qu'UNE seule fois avec mon booleen.

Donc ajoute un bouton dans la feuille et copie colle ce code.

Private Sub CommandButton1_Click()
Static EnCours As Boolean
   'Pour se protéger de la "récursivité"
   If Not EnCours Then
       EnCours = True
   Else
       Exit Sub
   End If
   Dim MColor As Integer
   Application.ScreenUpdating = False 'Pour désactiver la mise à jour de l'affichage
   
   For Each c In Worksheets(1).Range("b1:b500")
       Select Case c.Value
           Case "prt": MColor = 4
                      Range("K" & c.Row).Value = "--"
           Case "unit": MColor = 6
           Case "ms": MColor = 50
           Case "os": MColor = 38
           Case "ps": MColor = 8
           Case "es": MColor = 45
           Case "obj": MColor = 48
           Case vbNullString: MColor = 0
       End Select
       
       c.Interior.ColorIndex = MColor
       c.Font.ColorIndex = 0       If MColor 0 Then c.Font.Bold False       If MColor 4 Or MColor 45 Then Range("D" & c.Row).Interior.ColorIndex = MColor
   Next c
 
   Application.ScreenUpdating = True
   'petite ligne a rajouter si on veut le faire
   'plus d'une fois
   EnCours = False
End Sub<hr />
, ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée

pascal7376 · Answer

Ok l'idée me plait
Donc j'ajoute un bouton dans une barre d'outils mais ensuite comment dois-je faire pour lui mettre le code???

jrivet · Answer

Salut,
Et bien faut tout te mâcher à toi. Tu sais il faudrait essayer un peu par toi même de découvrir les fonctionnalités proposées par Excel. Jusqu'à présent on t'a tout de même bien faliciter le travail. Essaie de voir la suite tout seul.

Tu ajoutes un bouton dans UNE FEUILLE puis tu doubles click dessus ca va t'ouvrir l'éditeur VBA et ensuite copie colle.

@+: Ju£i?n
Pensez: 
Réponse acceptée

pascal7376 · Answer

Tout marche à merveille... vous avez rendu quelqu'un heureux un grand merci et je vais essayer de comprendre comment ca marche....

jrivet · Answer

Salut,
Dernière chose.
Si tu estimes que ton problème de départ est résolu ("Tout marche à merveille"), alors penses à appuyer sur le bouton réponse acceptée sur le ou les post qui ont pu t'aider à avancer.

(ensuite si tu rencontres d'autres problèmes rien ne t'empêcheras de poser une nouvelle question dans un topic tout neuf.)

@+: Ju£i?n
Pensez: Réponse acceptée

pascal7376 · Answer

Je viens de la soumettre à une séance de torture.... elle fonctionne à merveille.... juste un petit bug....
si sur une ligne je mets "prt", elle va mettre la couleur correspondante....
si la ligne en dessous j'écris "salut", elle prendra la couleur de la ligne précédente....
mais si je mets un code "prt" "ms" "os" ... comme dans la macro, pas de soucis mais une faute de frappe, reprend la couleur de la ligne avant....
bizarre, non? en tout cas pour moi....lol

pascal7376 · Answer

Que dire à part parfait et un grand merci

jrivet · Answer

Salut,
Alors pense a ce que je t'ai dit et appuie sur le bouton réponse acceptée sur le ou LES posts qui ont pu t'aider.
MERCI

@+: Ju£i?n
Pensez: Réponse acceptée

pascal7376 · Answer

Encore moi.... Je pensais pouvoir résoudre un petit prob seul mais je crois que je ne connais pas encore assez de chose...


Si je veux dans la colonne G que le texte "p" soit remplacé par "divers"¨


Que dois-je rajouter à la macro???


Voici ce que j'ai essayé sans succès:


Private Sub COULEUR_Click()
Static EnCours As Boolean
   'Pour se protéger de la "récursivité"
   If Not EnCours Then
       EnCours = True
   Else
       Exit Sub
   End If
   Dim MColor As Integer
   Application.ScreenUpdating = False 'Pour désactiver la mise à jour de l'affichage
    
   For Each c In Worksheets(1).Range("b1:b500")
       Select Case c.Value
           Case "prt": MColor = 4
                      Range("K" & c.Row).Value = "Alphacos"
           Case "unit": MColor = 6
           Case "ms": MColor = 50
           Case "os": MColor = 38
           Case "ps": MColor = 8
           Case "es": MColor = 45
           Case "obj": MColor = 48
           Case Else: MColor = 0
       End Select
        
       c.Interior.ColorIndex = MColor
       c.Font.ColorIndex = 0       If MColor 0 Then c.Font.Bold False       If MColor 4 Or MColor 6 Or MColor = 50 Or MColor = 38 Or MColor = 8 Or MColor = 45 Or MColor = 48 Or MColor = 0 Then Range("D" & c.Row).Interior.ColorIndex = MColor
   Next c
  
  
  For Each c In Worksheets(1).Range("G1:G500")
       Select Case c.Value
           Case "p": Value = "Divers"
       End Select
           
           
   Next c
   
   Application.ScreenUpdating = True
   'petite ligne a rajouter si on veut le faire
   'plus d'une fois
   EnCours = False


End Sub

jrivet · Answer

'Si tu veux juste remplacer dans le cas ou il a "p" 'fais ceci For Each c In Worksheets(1).Range("G1:G500") If c.Value "p" Then c.Value "Divers" Next c , ---- Ju£i?n Pensez: Réponse acceptée

pascal7376 · Answer

Génial ca marche... décidement quand on connait on peut faire ce qu'on veut.... je vous envie un peu....
avec la macro peux-tu lui dire de mettre une couleur au texte que la macro va écrire?
Genre que le texte Alphacos soit rouge...?
Et est-ce possible de "verrouiller" certaine cellule? c-a-d que meme si il y a "prt" en B72 (ex), de ne pas forcément mettre alphacos en K72, car K72 est "verrouiller"...
Ou alors est-ce que la ca devient trop difficile...

Private Sub COULEUR_Click()
Static EnCours As Boolean
   'Pour se protéger de la "récursivité"
   If Not EnCours Then
       EnCours =  True
   Else
       Exit Sub
   End If
   Dim MColor As Integer
   Application.ScreenUpdating = False 'Pour désactiver la mise à jour de l'affichage
    
   For Each c In Worksheets(1).Range("b1:b500")
       Select Case c.Value
           Case "prt": MColor = 4
                      Range("K" & c.Row).Value = " Alphacos "
           Case "unit": MColor  = 6
                      Range("K" & c.Row).Value =  " Alphacos "
           Case "ms": MColor  = 50
           Case "os": MColor = 38
           Case "ps": MColor = 8
           Case "es": MColor = 45
           Case "obj": MColor = 48
           Case Else: MColor = 0
       End Select
        
       c.Interior.ColorIndex = MColor
       c.Font.ColorIndex = 0       If MColor 0 Then c.Font.Bold False       If MColor 4 Or MColor 6 Or MColor = 50 Or MColor = 38 Or MColor = 8 Or MColor = 45 Or MColor = 48 Or MColor = 0 Then Range("D" & c.Row).Interior.ColorIndex = MColor
   Next c
  
  For Each c In Worksheets(1).Range("G1:G500")   If c.Value "Material <not specified>" Then c.Value "Divers"
Next c


   
   Application.ScreenUpdating = True
   'petite ligne a rajouter si on veut le faire
   'plus d'une fois
   EnCours = False


End Sub

jrivet · Answer

Re, Essaies Voir de le Faire tout seul.En anglais police FONT donc a ton avis la ligne c.Font.ColorIndex 0 qu'est ce qu'elle fait pourquoi la tu mise.... Il faut être logique un peu. Tu recommence à essayer de faire en sorte que l'on te mâche tout. et ca devient lassant. Ce n'est pas le fait de le savoir, mais si tu ne cherches pas un minimum comment tu veux t'améliorer. Regarde l'outil que te propose EXCEL et qui s'appelle enregistreur de Macro. la couleur de la police est c.Font.Color VbRed ou alors c.Font.ColorIndex 4 De meme pour le Verouillage (qui soit dit en passant n'aura de l'effet que si la feuille est protégée) se dit Lock en anglais. Donc en regardant un minimum if c.locked = True then msgbox "cellule protégée" @+: Ju£i?n Pensez: Réponse acceptée

pascal7376 · Answer

Merci me ne croyez pas que je n'essaie pas.... mais quand vous partez à zéro c'est très difficile... j'essaie de comprendre...

jrivet · Answer

Re,
Alors tu as au moins résussi avec ce que je viens de te dire normalement?

Quel en est le code résultant ?

Note: 
Ce IF est TOTALEMENT inutile puisque MColor ne peu pas prendre d'autre valeur que celle que tu mets dans le If 
If MColor 4 Or MColor 6 Or MColor = 50 Or MColor = 38 Or MColor = 8
Or MColor 45 Or MColor 48 Or MColor = 0 Then Range("D" &
c.Row).Interior.ColorIndex = MColor
   Next c

Deviendrait Donc simplement

Range("D" &
c.Row).Interior.ColorIndex = MColor
@+: Ju£i?n
Pensez: Réponse acceptée

pascal7376 · Answer

wahoo pas facile à suivre j'ai presque l'impression de parler une autre langue.... En fait la difficulté pour moi c'est sur la colonne K lorsque la macro met "Alphacos" si B est "prt". Et la j'aimerais que "alphacos" soit en couleur 56

Private Sub COULEUR_Click()
Static EnCours As Boolean
   'Pour se protéger de la "récursivité"
   If Not EnCours Then
       EnCours =  True
   Else
       Exit Sub
   End If
   Dim MColor As Integer
   Application.ScreenUpdating = False 'Pour désactiver la mise à jour de l'affichage
    
   For Each c In Worksheets(1).Range("b19:b5000")
       Select Case c.Value
           Case "prt": MColor = 4
                      Range("K" & c.Row).Value = "Alphacos"
                       c.Font.ColorIndex = 56 
           Case "unit": MColor  = 6
                       Range("K" & c.Row).Value = "Alphacos"
           Case "ms": MColor = 50
           Case "os": MColor = 38
           Case "ps": MColor = 8
           Case "es": MColor = 45
           Case "obj": MColor = 48
           Case Else: MColor = 0
       End Select
        
       c.Interior.ColorIndex = MColor
       c.Font.ColorIndex = 0       If MColor 0 Then c.Font.Bold False       If MColor 4 Or MColor 6 Or MColor = 50 Or MColor = 38 Or MColor = 8 Or MColor = 45 Or MColor = 48 Or MColor = 0 Then Range("D" & c.Row).Interior.ColorIndex = MColor
   Next c
  
  For Each c In Worksheets(1).Range("G19:G5000")   If c.Value "Material <not specified>" Then c.Value "Divers"
Next c


   
   Application.ScreenUpdating = True
   'petite ligne a rajouter si on veut le faire
   'plus d'une fois
   EnCours = False


End Sub

jrivet · Answer

Re,
La encore question de logique,

Si tu as mis "Alphacos" dans  Range("K" & c.Row) pourquoi à la ligne suivante tu essaie de modifer la couleur de c (qui je te rappelle correspond à la cellule B)

Il faut donc que tu mettes Range("K" & c.Row).Font.ColorIndex = 56 

@+: Ju£i?n
Pensez: Réponse acceptée

pascal7376 · Answer

J'ai pu modifer le  If MColor 4 Or MColor 6....
Et j'ai compris pourquoi... c'est un bon début...
J'ai essayé avec la marco de rechercher dans les cases du texte comme celui-ci... "SW-M...." mais la fin n'est jamais la même et le début non plus mais j'ai toujours SW-M j'ai essayé avec des * mais ca ne marche pas....
Y a-t-il un autre symbole dans les macros... l'aide d'excel ne m'a pas aidé...

pascal7376 · Answer

Les choses commencent à s'éclaircir.... je commence à comprendre la philosophie de travail....

pascal7376 · Answer

Mais toujours pas trouvé comment faire pour qu'il recherche pas le texte complet mais une partie.... c-a-d de trouvé les cases qui comportent au moins "SW-M" même si il y a du texte avant ou apres....

pascal7376 · Answer

Pouvez-vous encore m'aider cette fois... je seche.... svp merci

jrivet · Answer

Re,
Pour trouver "SW-M" dans une chaine de caractere il te faut utiliser la méthode Instr

Exemple:
Dim MaChaine As String
MaChaine = "ABCDSW-MAFDTOF"
'1 = recherche a partir du premier caractere
If InStr(1, MaChaine, "SW-M") Then MsgBox MaChaine & " Contient SW-M"
, ----
[code.aspx?ID=41455 By Renfield]
Donc pour toi tu devras remplacer MaChaine par C.Value (ou qqch dans le genre)

@+: Ju£i?n
Pensez: Réponse acceptée

pascal7376 · Answer

Je n'ai pas réussi mais je ne veux pas la réponse... je veux de l'aide pour que je puisse seul...

Dim MaChaine As String
MaChaine = .Range("G19:G5000")
'1 = recherche a partir du premier caractere
If InStr(1, MaChaine, "SW-M") Then c.Value = "TEST"

J'aimerais que dans la colonne G, les cases avec du text SW-M soit remplacé par TEST

Suis-je loin de la vérité....
Quelques indices?

jrivet · Answer

SAlut,
REssert du meme principe que 

For Each c In Worksheets(1).Range("G19:G5000")
    C'est la que tu teste avec instr sur la valeur de la cellule c.   

Next c
@+: Ju£i?n
Pensez: Réponse acceptée

pascal7376 · Answer

Trop cool ca marche et j'ai même réussi à faire autre choses.... Merci beaucoup

Macro excel

49 réponses

Votre réponse

Discussions similaires