Mise en forme conditionnelle VBA excelRésolu

Question

Bonjour,
Je souhaiterais, dans excel, avec une macro, sélectionner une plage (morceau d'une ligne) et dans cette plage mettre en couleur (rouge par exemple) et en gras les x plus grandes valeurs, sachant que "x" est une valeur inscrite dans une cellule (A1 par exemple).
Ensuite, dans chaque cellule adjacente à cette ligne (à droite), je voudrais que soit calculée la somme des valeurs des cellules en rouge (et gras).
Ceci serait réalisé sur une centaine de colonnes.

 En fait, c'est pour faire réaliser un classement pour une association sportive, au lieu de tout faire à la main ! (comme c'est le cas jusqu'à présent)

Si quelqu'un a une solution à mon problème, qu'il n'hésite pas... 
Merci

jrivet · Accepted Answer

Re,
Oups, petit buig de ma part je recherchais toujours la premiere valeur dans la plage de donnée avec Find, je n'avais pas prévue que l'on pouvais avoir plusieurs fois les même valeurs.
Essaie donc celle ci alors.

Dim i As Integer
Dim ValMax As Long
Dim TotalMax As Long

   'Selection de la plage de recherche
   Range("A1:D4").Select
   
   'Enleve tout les valeur en gras
   Selection.Font.Bold = False
   Selection.Interior.ColorIndex = xlNone
   'De 1 à la valeur saisie dans E1
   '=> le nombre de valeurs cherchées
   For i = 1 To ActiveSheet.Range("E1").Value
       'Récupération des X plus grande valeur
       ValMax = Application.WorksheetFunction.Large(Selection, i)
       'Recherche de la valeur dans la meme plage de recherche
       Call Selection.Find(ValMax, , xlValues).Activate
       'Si la cellule est déjà en gras c'est qu'on doit chercher
       'l'occurence suivante
       While ActiveCell.Font.Bold = True
           'On recherche donc une nouvelle fois dans la plage
           Call Selection.Find(ValMax, ActiveCell, xlValues).Activate
       Wend
       
       'Avec la cellule active
       With ActiveCell
           'On met en gras
           .Font.Bold = True
           'On colore en rouge
           .Interior.Color = vbRed
       End With
       TotalMax = TotalMax + ValMax
   Next
   'On place le total en F1
   ActiveSheet.Range("F1").Value = TotalMax
   Call ActiveSheet.Range("F1").Select, ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée

cs_MPi · Answer

Regarde du côté de
Range("...").Interior.Color
Range("...").Font.Bold

Ensuite, il ne te reste qu'à créer une boucle et vérifier ces valeurs, ligne par ligne
Si la cellule en est une recherchée (valeur, couleur, gras...), tu l'additionnes dans une variable.
Lorsque la boucle est terminée, tu inscris ce total dans la colonne que tu veux.
et tu continues la boucle en remettant le total à 0 au début de la lecture de chaque ligne

MPi

CescoCorp · Answer

Merci pour cette réponse qui correspond à ce que je recherchais, à une exception près, c'est que le nombre de plus grandes valeurs à mettre en forme, je ne le connais pas, puisqu'il est défini par une cellule que l'utilisateur peut modifier. 

Par exemple, il choisit de prendre en compte 5 courses, il marque alors cette valeur dans la cellule. Mais comment puis-je faire pour que le nombre de cellules en gras correspond ici à 5 (il faut que ça puisse changer à chaque fois) ? 

CescoCorp.

jrivet · Answer

Salut,
Cet exemple met en gras et en rouge les X plus grandes valeurs (X etant saisie dans la cellule E1) de la plage A1 => D4
IL Calcule aussi la somme de ces plus grandes valeurs et place le résultat dans la cellule F1

Voila il ne reste plus qu'a l'adapter à tes besoins.

Dim i As Integer
Dim ValMax As Long
Dim TotalMax As Long

   'Selection de la plage de recherche
   Range("A1:D4").Select
   
   'Enleve tout les valeur en gras
   Selection.Font.Bold = False
   Selection.Font.Color = vbBlack
   'De 1 à la valeur saisie dans E1
   '=> le nombre de valeurs cherchées
   For i = 1 To ActiveSheet.Range("E1").Value
       'Récupération des X plus grande valeur
       ValMax = Application.WorksheetFunction.Large(Selection, i)
       'Recherche de la valeur dans la meme plage de recherche
       With Selection.Find(ValMax, , xlValues).Font
           'On met en gras
           .Bold = True
           'On colore en rouge
           .Color = vbRed
       End With
       TotalMax = TotalMax + ValMax
   Next
   'On place le total en F1
   ActiveSheet.Range("F1").Value = TotalMax
   Call ActiveSheet.Range("F1").Select, ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée

CescoCorp · Answer

Bonjour,

 Franchement merci beaucoup pour cette macro, je ne voyais vraiment pas comment prendre en compte la valeur de la cellule E1 et là, tout est résolu... ou presque.

En fait j'ai modifié le code de manière à mettre en couleur la cellule et non la police et de façon à calculer pour chaque ligne le TotalMax (en prenant en compte le fait qu'il puisse y avoir des cellules vides), et ça fonctionne bien.

 En revanche, le seul problème que je ne parviens pas à résoudre, c'est que lorsqu'il y a plusieurs fois la même valeur sur la ligne (par exemple un "8"), seul l'un d'entre eux est mis en forme. Pourtant, le TotalMax est bon.

Je m'explique, par exemple les valeurs sur la ligne 1 :     3 | 5 | 8 | 8 
Si la valeur E1 vaut 3 (choix de l'utilisateur), les 3 plus grandes valeurs sont additionnées (soit TotalMax = 21). Mais seul le "5" et le 1er "8" sont mis en forme (gras et fond rouge).

Si quelqu'un a une solution, je suis volontier preneur ! 
Merci d'avance

CescoCorp.

CescoCorp · Answer

Bon bah voilà, je n'ai plus rien à dire , si ce n'est évidemment MERCI !
Ca marche parfaitement !

Tous mes problèmes sont résolus.

Amicalement,

CescoCorp.

jrivet · Answer

Re,

Si tu estimes que ton problème est résolu, penses à appuyer sur réponse acceptée sur le post ou les posts, cela à pour but de valider ta réponse. (et de me donner des points )

@+: Ju£i?n
Pensez: Réponse acceptée

CescoCorp · Answer

C'était donc pour ça "réponse acceptée" !  En fait, j'ai un dernier petit soucis, que je pensais résoudre tout seul; mais finalement...

Je voudrais pouvoir copier les cellules (B5 à B[dernière cellule non vide]) de la feuille "feuil1" et coller dans "feuil2" (A3 à A[même valeur qu'avant -2 ?!])

 Ne t'inquiète pas, je vais cliquer sur "réponse acceptée" puisque mon vrai problème a été résolu.

CescoCorp.

jrivet · Answer

Salut,

Essaie ceci
    With ActiveWorkbook.Worksheets("Feuil1")
       'Selection B5 de la feuille 1
       .Range("B5").Select
       'Va jusqua la derniere cellule non vide
       '(ATTENTION peu etre des soucis vers le bas de la feuille)
       .Range(Selection, Selection.End(xlDown)).Select
   End With
   'Copie la selection
   Selection.Copy
   'Active  la feuille 2
   ActiveWorkbook.Worksheets("Feuil2").Select
   'Active A3
   ActiveSheet.Range("A3").Select
   'Colle la selection
   ActiveSheet.Paste, ----
[code.aspx?ID=41455 By Renfield]

Petit conseil qui peut s'avérer très pratique. Excel possède un enregistreur de macro 
Si tu fais Menu Outils => Macro => Nouvelle macro,  Excel se mettra alors à enregistrer toutes tes actions jusqu'à ce que tu arrête l'enregistrement.

une fois arrêter, si tu vas dans l'editeur VBA, Excel t'a créer un module où il a placer le code correspondant à TOUTES les actions effectuées lors de l'enregistrement.
Il faut bien entendu parfois épurer le code mais, ça aide bien lorsque tu ne sais pas du tout comment faire une action par code.

@+: Ju£i?n
Pensez: Réponse acceptée

CescoCorp · Answer

Merci pour cette réponse, mais en fait j'ai réussi à résoudre ce problème là en "feuilletant" internet...

Cependant, si tu te souviens de ce que je voulais faire avant (total des x plus grandes valeurs avec mise en forme de ces valeurs), il y a un nouveau problème que je viens de rencontrer.

Je vais prendre un exemple pour que ce soit plus simple à comprendre

Nombre de courses prises en compte : 4
Les cellules :  8 | 2 |   |   | 7 |
Les 4 plus grandes seront 8, 7, 2 et...rien donc ERREUR
En fait j'ai des cellules sans valeur. Donc j'avais résolu ce problème en remplacant pour chaque ligne "" par 0. Oui mais les valeurs de chaque cellule proviennent de formules. Alors si je mets un 0, je n'ai plus mes formules et donc si je refait un tri, certaines valeurs seront fausses.

J'ai donc trouvé une solution : copier les valeurs dans une nouvelle page pour pouvoir ensuite remplacer "" par 0 mais je pense qu'il doit y avoir plus pratique (?)

C'est pourquoi je pose la question ici, en espérant que vous ayez réussi à comprendre mon problème.

Amicalement,

CescoCorp.

cs_MPi · Answer

Tout dépend de ta formule.Tu peux lui dire de mettre 0 si le résultat ""Si(MaFormule=""; 0; MaFormule)

MPi

CescoCorp · Answer

Bonsoir,
 Hélàs ce n'est pas possible parce qu'en fait dans la première feuille, l'utilisateur inscrit les places (1er, 2e,...). Ensuite j'ai fait des formules dans ma feuille "classement" de manière à ce que le 1er 50 pts, le 2e 45,... Donc chaque cellule a une formule, même si une voiture de la liste n'a pas couru. Bilan, si je mets un 0 à la place des "" pour faire mon calcul de points total, je perds ma formule (qui n'est pas ici une macro), et donc cette cellule restera définitivement vide, même (et surtout) après un tri.

J'espère que tu vois où je veux en venir. 

Amicalement,

CescoCorp.

jrivet · Answer

Salut,
En modifiant le code de départ et en captant l'erreur cela devrait résoudre ce petit problème.
Essaies donc ceci.

Private Sub CommandButton1_Click()
Dim i As Integer
'NOTE ValMax change de type
Dim ValMax As String
Dim TotalMax As Long

  'Selection de la plage de recherche
  Range("A1:D4").Select
 
  'Enleve tout les valeur en gras
  Selection.Font.Bold = False
  Selection.Interior.ColorIndex = xlNone
  'De 1 à la valeur saisie dans E1
  '=> le nombre de valeurs cherchées
  For i = 1 To ActiveSheet.Range("E1").Value
      'Appel la fonction de récupération de la plus grande valeur
      ValMax = GetNextMaxValue(i)
      ' Si la valeur retournée par la fonction est "" => VbNullstring
      'Alors plus la peine de continuer
      If ValMax = vbNullString Then Exit For
      'Recherche de la valeur dans la meme plage de recherche
      Call Selection.Find(ValMax, , xlValues).Activate
      'Si la cellule est déjà en gras c'est qu'on doit chercher
      'l'occurence suivante
      While ActiveCell.Font.Bold = True
          'On recherche donc une nouvelle fois dans la plage
          Call Selection.Find(ValMax, ActiveCell, xlValues).Activate
      Wend
     
      'Avec la cellule active
      With ActiveCell
          'On met en gras
          .Font.Bold = True
          'On colore en rouge
          .Interior.Color = vbRed
      End With
      TotalMax = TotalMax + ValMax
  Next
  'On place le total en F1
  ActiveSheet.Range("F1").Value = TotalMax
  Call ActiveSheet.Range("F1").Select
End Sub

Private Function GetNextMaxValue(ByVal NumVal As Integer) As String
'Petite astuce: on va capter l'erreur
   On Error GoTo HandleError
   
   GetNextMaxValue = Application.WorksheetFunction.Large(Selection, NumVal)
   'Pas nécessaire mais pour l'idée
   Exit Function
HandleError:

End Function
, ----
[code.aspx?ID=41455 By Renfield]

J'espère au moins que ceci était bien le problème rencontré (sinon j'ai rien compris )

@+: Ju£i?n
Pensez: Réponse acceptée

CescoCorp · Answer

Merci beaucoup pour cette réponse. Elle répond exactement à mes attentes.
Je n'ai plus de problèmes. Merci encore !

CescoCorp.

Mise en forme conditionnelle VBA excel

14 réponses

Votre réponse

Discussions similaires