première macro - assistance recommandée

Chris_m45 · 7 Août 2008

bonjour

Ma première macro a pour objectif de balayer les cellules de [C3:I8]
et d'y mettre de la couleur en fonction d'un pourcentage calculée sur la valuer trouvee en B de la meme ligne.

la macro qui boucle test si on réinit "pascouleur" les cellule ou si on applique les critère "couleur"

Dans raz_couleur . Je galère depuis que j'essaie de calculer le pourcentage sur toutes les lignes; j'ai forcé la valeure B3

pourcen = (valeure * 100) / Range("B3").Value

mais en fait si j'en suis a la ligne C cela devrait etre C3, si j'en suis à la ligne D cela devrait etre D3 ...

comment calculer la variable pourcen en fonction de la cellule active

Je précise que je demande toute l'indulgence du lecteur sur la qualité du code

================

Sub boucle_indicateurs(paramètre1 As String)

Application.ScreenUpdating = False

Dim l As Long
Dim c, celluleorigine, celluleencours

celluleorigine = 0

For Each c In [C3:I8] 'plage a testée
c.Select

l = ActiveCell.[Row]

If celluleorigine = 0 Then
celluleorigine = ActiveCell.Address 'pour re positionner curseur
End If

celluleencours = ActiveCell.Address

If paramètre1 = "Couleur" Then
Call Colorer_les_Chiffres
End If

If paramètre1 = "PasCouleur" Then
Call raz_couleur
End If

Next
Application.ScreenUpdating = True
Range(celluleorigine).Select

==========
Sub Colorer_les_Chiffres()

Dim pourcen, valeure

valeure = ActiveCell.Value

pourcen = (valeure * 100) / Range("B3").Value

Select Case pourcen

Case 0 To 25 '<25%

Selection.Interior.ColorIndex = 3
Selection.Font.Bold = True

Case 26 To 50 'de 25% à 49%
Selection.Interior.ColorIndex = 46
Selection.Font.Bold = True

Case 51 To 75
Selection.Interior.ColorIndex = 42
Selection.Font.Bold = True

Case 76 To 100
Selection.Interior.ColorIndex = 4
Selection.Font.Bold = True

End Select

End Sub

wilfried_42 · 7 Août 2008

Re : première macro - assistance recommandée

Bonjour

Code:

Sub boucle_indicateurs(paramètre1 As String)
       if paramètre1 = "Pascouleur" then
              range("C3:I8").interior.colorindex = xlnone ' possibilité de travailler en une fois sur la plage complete
              range("C3:I8").font.bold = false
              exit sub
      end if
       Application.ScreenUpdating = False
       Dim c as range ' declaration de la varialble c comme une cellule
       For each c in range("C3:I8") ' c etant une cellule, c.value contient sa valeur, pas besoin de la selectionner avec un select
      Select Case (c.value * 100) / cells(3,c.column).value
           Case 0 To 25 '<25%
               c.Interior.ColorIndex = 3
               c.Font.Bold = True

           Case 26 To 50 'de 25% à 49%
               c.Interior.ColorIndex = 46
               c.Font.Bold = True
           Case 51 To 75
               c.Interior.ColorIndex = 42
               c.Font.Bold = True
           Case 76 To 100
               c.Interior.ColorIndex = 4
               c.Font.Bold = True
       End Select
       Next
       Application.ScreenUpdating = True
End Sub

si j'ai tout compris

Compte Supprimé 979 · 7 Août 2008

Re : première macro - assistance recommandée

Salut Chris_m45, bienvenue sur ce forum 😉

Pour ton premier code, je ne dirais rien 😀
Mais tu n'est pas obligé de sélectionner une cellule pour travailler dessus

Voici ton code, légèrement rectifié 😀
Il manque la Sub raz_couleur !?

Code:

Option Explicit
Sub boucle_indicateurs(paramètre1 As String)
Dim c As Range, celluleorigine
Application.ScreenUpdating = False
celluleorigine = ActiveCell.Address
For Each c In Range("C3:I8") 'plage a testée
  If paramètre1 = "Couleur" Then
    Call Colorer_les_Chiffres(c)
  End If
 
  If paramètre1 = "PasCouleur" Then
    Call raz_couleur(c)
  End If
Next
Application.ScreenUpdating = True
Range(celluleorigine).Select
End Sub
Sub Colorer_les_Chiffres(Cel As Range)
Dim pourcen, valeure, Lig As Long
valeure = Cel.Value
Lig = Cel.Row
pourcen = (valeure * 100) / Range("B" & Lig).Value
Select Case pourcen
  Case 0 To 25 '<25%
  Cel.Interior.ColorIndex = 3
  Cel.Font.Bold = True
 
  Case 26 To 50 'de 25% à 49%
  Cel.Interior.ColorIndex = 46
  Cel.Font.Bold = True
 
  Case 51 To 75
  Cel.Interior.ColorIndex = 42
  Cel.Font.Bold = True
 
  Case 76 To 100
  Cel.Interior.ColorIndex = 4
  Cel.Font.Bold = True
End Select
End Sub

A+

Edit : Oups, salut wilfried
peut-être pas facile à lire ton code pour un novice 😛

wilfried_42 · 7 Août 2008

Re : première macro - assistance recommandée

re: bonjour bruno 🙂

je n'ai reellement changé que le select mais comme le pourcentage est par rapport à la colonne (c'est ce que j'ai compris), j'ai du mettre cells plutot que range

bonne soirée et @ +

Chris_m45 · 7 Août 2008

Re : première macro - assistance recommandée

Merci à vous deux,

je regarde d'abor la soluce de wilfried car elle me parait plus abordable dans un premier temps. Dans un deuxième temps je plonge sur la soluce de Bruno (un local ?) pour me permettre de m'impregner de l'esprit excel.

par contre wilfried j'ai depasement de capacité

pourcen = (valeure * 100) / Range("B" & Lig).Value

wilfried_42 · 7 Août 2008

Re : première macro - assistance recommandée

re:

c'est pour bruno la question 😀

Chris_m45 · 7 Août 2008

Re : première macro - assistance recommandée

exact je m'ave trompé et croisé les prénoms 😱

pierrejean · 7 Août 2008

Re : première macro - assistance recommandée

bonjour a tous

Une petite remarque pour agiter les neurones de Chris

Que se passe-t-il si pourcen vaut 25,5 par exemple ?

Chris_m45 · 7 Août 2008

Re : première macro - assistance recommandée

pierrejean à dit:
bonjour a tous

Une petite remarque pour agiter les neurones de Chris

Que se passe-t-il si pourcen vaut 25,5 par exemple ?

Effectivement Pierre jean

il y aurait comme un trou dans la raquette

wilfried_42 · 7 Août 2008

Re : première macro - assistance recommandée

re: bonjur pierrejean 🙂

personnellement je pense que 25,5 se trouve entre 25 et 26

tests effectués et reussi (mais en VBA mettre un point decimal et non une virgule

Code:

Sub essai()
a = 25
Select Case a
    Case 0.01 To 25
        MsgBox "1"
    Case 25.01 To 50
        MsgBox "2"
    Case 50.01 To 75
        MsgBox 3
    Case Else
        MsgBox 4
End Select
End Sub

pierrejean · 7 Août 2008

Re : première macro - assistance recommandée

Re

Wilfried tu m'etonnes !!

Je pense que tu as reduit les trous de la raquette mais ils sont toujours la

teste avec a=25.005

pour ma part je proposerais tout en sachant que subsitent des petits (tout petits trous)

Code:

Sub essai()
a = 25.005
Select Case a
    Case 0.00000000001 To 25
        MsgBox "1"
    Case 25.00000000001 To 50
        MsgBox "2"
    Case 50.00000000001 To 75
        MsgBox 3
    Case Else
        MsgBox 4
End Select
End Sub

wilfried_42 · 7 Août 2008

Re : première macro - assistance recommandée

re:

je suis d'accord avec toi pierrejean, je les regle comme cela les trous 😀

Code:

      Select Case Round((c.Value * 100) / Cells(3, c.Column).Value, 2)
             case 0 to 24.99
             case 25 to 49.99
             case 50 to 74.99
             case else ' >= 75
      end select

ce qui me parait beaucoup plus logique comme formulation 😛
aussi bien dans le code que dans le bornage 😀

pierrejean · 7 Août 2008

Re : première macro - assistance recommandée

Re

BRAVO !!!

C'est effectivement cela la solution

Chris_m45 · 8 Août 2008

Re : première macro - assistance recommandée

Merci à tous

Grace à vos contributions Excel commence à me tenter

Effectuez une recherche sur Excel Downloads...

première macro - assistance recommandée

Chris_m45

Guest

wilfried_42

XLDnaute Barbatruc

Compte Supprimé 979

Guest

wilfried_42

XLDnaute Barbatruc

Chris_m45

Guest

wilfried_42

XLDnaute Barbatruc

Chris_m45

Guest

pierrejean

XLDnaute Barbatruc

Chris_m45

Guest

wilfried_42

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

wilfried_42

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

Chris_m45

Guest

Discussions similaires

Nous accordons de l'importance à votre vie privée