aide à simplifier une macro trop lourde

oliwood · 2 Octobre 2013

bon j'ai réussi à créer une macro avec ce que j'ai trouvé sur le net donc ici lol
mais la macro est lourde et j'arrive pas à la simplifier...
si qqun pouvait m'aider me donner une piste ou une idée ce serait sympa...

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   'si vide alors police blanche

For i = 4 To 25
     If Range("B" & i) = "" Then Range("B" & i).Font.ColorIndex = 2
     If Range("C" & i) = "" Then Range("C" & i).Font.ColorIndex = 2
     If Range("E" & i) = "" Then Range("E" & i).Font.ColorIndex = 2
     If Range("F" & i) = "" Then Range("F" & i).Font.ColorIndex = 2
     If Range("H" & i) = "" Then Range("H" & i).Font.ColorIndex = 2
     If Range("I" & i) = "" Then Range("I" & i).Font.ColorIndex = 2
     If Range("K" & i) = "" Then Range("K" & i).Font.ColorIndex = 2
     If Range("L" & i) = "" Then Range("L" & i).Font.ColorIndex = 2

Next
'si cellule voulue alors police change de couleur
For cas = 4 To 25
     If Target.Address = "$B$" & cas Then
        If Range("B" & cas & ":C" & cas).Font.ColorIndex = 1 Then
          Range("B" & cas & ":C" & cas).Font.ColorIndex = 2
        
         Else
           Range("B" & cas & ":C" & cas).Font.ColorIndex = 1
         End If
        End If
        
      If Target.Address = "$E$" & cas Then
        If Range("E" & cas & ":F" & cas).Font.ColorIndex = 1 Then
          Range("E" & cas & ":F" & cas).Font.ColorIndex = 2
         Else
           Range("E" & cas & ":F" & cas).Font.ColorIndex = 1
         End If
        End If
        
        If Target.Address = "$H$" & cas Then
        If Range("H" & cas & ":I" & cas).Font.ColorIndex = 1 Then
          Range("H" & cas & ":I" & cas).Font.ColorIndex = 2
        
         Else
           Range("H" & cas & ":I" & cas).Font.ColorIndex = 1
         End If
        End If
        
        If Target.Address = "$K$" & cas Then
        If Range("K" & cas & ":L" & cas).Font.ColorIndex = 1 Then
          Range("K" & cas & ":L" & cas).Font.ColorIndex = 2
        
         Else
           Range("K" & cas & ":L" & cas).Font.ColorIndex = 1
         End If
        End If
        
    Next
    'mise à zéro des cellules de compteur
         Range("a33") = ""
         Range("a34") = ""
         Range("a35") = ""
         Range("a36") = ""
        
         
     'compte le nombre de cellule à police noire
     For i = 4 To 25
          If Range("B" & i).Font.ColorIndex = 1 Then Range("a33") = Range("a33") + 1
          If Range("E" & i).Font.ColorIndex = 1 Then Range("a34") = Range("a34") + 1
          If Range("H" & i).Font.ColorIndex = 1 Then Range("a35") = Range("a35") + 1
          If Range("K" & i).Font.ColorIndex = 1 Then Range("a36") = Range("a36") + 1
          
     Next
    'différent totaux
      Range("c33") = Range("a33") + Range("a34")
      Range("c34") = Range("a35") + Range("a36")

      'total général
      Range("B27") = Range("A33") + Range("A34")
      Range("J27") = Range("A35") + Range("A36")
      
      Dim Plage As Range
    
    Set Plage = Range("A1:AM30")
    
    If Application.Intersect(Target, Plage) Is Nothing Then
    Exit Sub
    Else
    Union(Range(Cells(4, 14), Cells(4, 15)), Range(Cells(4, 26), Cells(4, 27))).Font.ColorIndex = Range("B4").Font.ColorIndex
    Union(Range(Cells(5, 14), Cells(5, 15)), Range(Cells(5, 26), Cells(5, 27))).Font.ColorIndex = Range("B5").Font.ColorIndex
    Union(Range(Cells(6, 14), Cells(6, 15)), Range(Cells(6, 26), Cells(6, 27))).Font.ColorIndex = Range("B6").Font.ColorIndex
    Union(Range(Cells(7, 14), Cells(7, 15)), Range(Cells(7, 26), Cells(7, 27))).Font.ColorIndex = Range("B7").Font.ColorIndex
    Union(Range(Cells(8, 14), Cells(8, 15)), Range(Cells(8, 26), Cells(8, 27))).Font.ColorIndex = Range("B8").Font.ColorIndex
    Union(Range(Cells(9, 14), Cells(9, 15)), Range(Cells(9, 26), Cells(9, 27))).Font.ColorIndex = Range("B9").Font.ColorIndex
    Union(Range(Cells(10, 14), Cells(10, 15)), Range(Cells(10, 26), Cells(10, 27))).Font.ColorIndex = Range("B10").Font.ColorIndex
    Union(Range(Cells(11, 14), Cells(11, 15)), Range(Cells(11, 26), Cells(11, 27))).Font.ColorIndex = Range("B11").Font.ColorIndex
    Union(Range(Cells(12, 14), Cells(12, 15)), Range(Cells(12, 26), Cells(12, 27))).Font.ColorIndex = Range("B12").Font.ColorIndex
    Union(Range(Cells(13, 14), Cells(13, 15)), Range(Cells(13, 26), Cells(13, 27))).Font.ColorIndex = Range("B13").Font.ColorIndex
    Union(Range(Cells(14, 14), Cells(14, 15)), Range(Cells(14, 26), Cells(14, 27))).Font.ColorIndex = Range("B14").Font.ColorIndex
    Union(Range(Cells(15, 14), Cells(15, 15)), Range(Cells(15, 26), Cells(15, 27))).Font.ColorIndex = Range("B15").Font.ColorIndex
    Union(Range(Cells(16, 14), Cells(16, 15)), Range(Cells(16, 26), Cells(16, 27))).Font.ColorIndex = Range("B16").Font.ColorIndex
    Union(Range(Cells(17, 14), Cells(17, 15)), Range(Cells(17, 26), Cells(17, 27))).Font.ColorIndex = Range("B17").Font.ColorIndex
    Union(Range(Cells(18, 14), Cells(18, 15)), Range(Cells(18, 26), Cells(18, 27))).Font.ColorIndex = Range("B18").Font.ColorIndex
    Union(Range(Cells(19, 14), Cells(19, 15)), Range(Cells(19, 26), Cells(19, 27))).Font.ColorIndex = Range("B19").Font.ColorIndex
    Union(Range(Cells(20, 14), Cells(20, 15)), Range(Cells(20, 26), Cells(20, 27))).Font.ColorIndex = Range("B20").Font.ColorIndex
    Union(Range(Cells(21, 14), Cells(21, 15)), Range(Cells(21, 26), Cells(21, 27))).Font.ColorIndex = Range("B21").Font.ColorIndex
    Union(Range(Cells(22, 14), Cells(22, 15)), Range(Cells(22, 26), Cells(22, 27))).Font.ColorIndex = Range("B22").Font.ColorIndex
    Union(Range(Cells(23, 14), Cells(23, 15)), Range(Cells(23, 26), Cells(23, 27))).Font.ColorIndex = Range("B23").Font.ColorIndex
    Union(Range(Cells(24, 14), Cells(24, 15)), Range(Cells(24, 26), Cells(24, 27))).Font.ColorIndex = Range("B24").Font.ColorIndex
    Union(Range(Cells(25, 14), Cells(25, 15)), Range(Cells(25, 26), Cells(25, 27))).Font.ColorIndex = Range("B25").Font.ColorIndex
    Union(Range(Cells(4, 17), Cells(4, 18)), Range(Cells(4, 29), Cells(4, 30))).Font.ColorIndex = Range("E4").Font.ColorIndex
    Union(Range(Cells(5, 17), Cells(5, 18)), Range(Cells(5, 29), Cells(5, 30))).Font.ColorIndex = Range("E5").Font.ColorIndex
    Union(Range(Cells(6, 17), Cells(6, 18)), Range(Cells(6, 29), Cells(6, 30))).Font.ColorIndex = Range("E6").Font.ColorIndex
    Union(Range(Cells(7, 17), Cells(7, 18)), Range(Cells(7, 29), Cells(7, 30))).Font.ColorIndex = Range("E7").Font.ColorIndex
    Union(Range(Cells(8, 17), Cells(8, 18)), Range(Cells(8, 29), Cells(8, 30))).Font.ColorIndex = Range("E8").Font.ColorIndex
    Union(Range(Cells(9, 17), Cells(9, 18)), Range(Cells(9, 29), Cells(9, 30))).Font.ColorIndex = Range("E9").Font.ColorIndex
    Union(Range(Cells(10, 17), Cells(10, 18)), Range(Cells(10, 29), Cells(10, 30))).Font.ColorIndex = Range("E10").Font.ColorIndex
    Union(Range(Cells(11, 17), Cells(11, 18)), Range(Cells(11, 29), Cells(11, 30))).Font.ColorIndex = Range("E11").Font.ColorIndex
    Union(Range(Cells(12, 17), Cells(12, 18)), Range(Cells(12, 29), Cells(12, 30))).Font.ColorIndex = Range("E12").Font.ColorIndex
    Union(Range(Cells(13, 17), Cells(13, 18)), Range(Cells(13, 29), Cells(13, 30))).Font.ColorIndex = Range("E13").Font.ColorIndex
    Union(Range(Cells(14, 17), Cells(14, 18)), Range(Cells(14, 29), Cells(14, 30))).Font.ColorIndex = Range("E14").Font.ColorIndex
    Union(Range(Cells(15, 17), Cells(15, 18)), Range(Cells(15, 29), Cells(15, 30))).Font.ColorIndex = Range("E15").Font.ColorIndex
    Union(Range(Cells(16, 17), Cells(16, 18)), Range(Cells(16, 29), Cells(16, 30))).Font.ColorIndex = Range("E16").Font.ColorIndex
    Union(Range(Cells(17, 17), Cells(17, 18)), Range(Cells(17, 29), Cells(17, 30))).Font.ColorIndex = Range("E17").Font.ColorIndex
    Union(Range(Cells(18, 17), Cells(18, 18)), Range(Cells(18, 29), Cells(18, 30))).Font.ColorIndex = Range("E18").Font.ColorIndex
    Union(Range(Cells(19, 17), Cells(19, 18)), Range(Cells(19, 29), Cells(19, 30))).Font.ColorIndex = Range("E19").Font.ColorIndex
    Union(Range(Cells(20, 17), Cells(20, 18)), Range(Cells(20, 29), Cells(20, 30))).Font.ColorIndex = Range("E20").Font.ColorIndex
    Union(Range(Cells(21, 17), Cells(21, 18)), Range(Cells(21, 29), Cells(21, 30))).Font.ColorIndex = Range("E21").Font.ColorIndex
    Union(Range(Cells(22, 17), Cells(22, 18)), Range(Cells(22, 29), Cells(22, 30))).Font.ColorIndex = Range("E22").Font.ColorIndex
    Union(Range(Cells(23, 17), Cells(23, 18)), Range(Cells(23, 29), Cells(23, 30))).Font.ColorIndex = Range("E23").Font.ColorIndex
    Union(Range(Cells(24, 17), Cells(24, 18)), Range(Cells(24, 29), Cells(24, 30))).Font.ColorIndex = Range("E24").Font.ColorIndex
    Union(Range(Cells(25, 17), Cells(25, 18)), Range(Cells(25, 29), Cells(25, 30))).Font.ColorIndex = Range("E25").Font.ColorIndex
    
    Union(Range(Cells(4, 20), Cells(4, 21)), Range(Cells(4, 32), Cells(4, 33))).Font.ColorIndex = Range("H4").Font.ColorIndex
    Union(Range(Cells(5, 20), Cells(5, 21)), Range(Cells(5, 32), Cells(5, 33))).Font.ColorIndex = Range("H5").Font.ColorIndex
    Union(Range(Cells(6, 20), Cells(6, 21)), Range(Cells(6, 32), Cells(6, 33))).Font.ColorIndex = Range("H6").Font.ColorIndex
    Union(Range(Cells(7, 20), Cells(7, 21)), Range(Cells(7, 32), Cells(7, 33))).Font.ColorIndex = Range("H7").Font.ColorIndex
    Union(Range(Cells(8, 20), Cells(8, 21)), Range(Cells(8, 32), Cells(8, 33))).Font.ColorIndex = Range("H8").Font.ColorIndex
    Union(Range(Cells(9, 20), Cells(9, 21)), Range(Cells(9, 32), Cells(9, 33))).Font.ColorIndex = Range("H9").Font.ColorIndex
    Union(Range(Cells(10, 20), Cells(10, 21)), Range(Cells(10, 32), Cells(10, 33))).Font.ColorIndex = Range("H10").Font.ColorIndex
    Union(Range(Cells(11, 20), Cells(11, 21)), Range(Cells(11, 32), Cells(11, 33))).Font.ColorIndex = Range("H11").Font.ColorIndex
    Union(Range(Cells(12, 20), Cells(12, 21)), Range(Cells(12, 32), Cells(12, 33))).Font.ColorIndex = Range("H12").Font.ColorIndex
    Union(Range(Cells(13, 20), Cells(13, 21)), Range(Cells(13, 32), Cells(13, 33))).Font.ColorIndex = Range("H13").Font.ColorIndex
    Union(Range(Cells(14, 20), Cells(14, 21)), Range(Cells(14, 32), Cells(14, 33))).Font.ColorIndex = Range("H14").Font.ColorIndex
    Union(Range(Cells(15, 20), Cells(15, 21)), Range(Cells(15, 32), Cells(15, 33))).Font.ColorIndex = Range("H15").Font.ColorIndex
    Union(Range(Cells(16, 20), Cells(16, 21)), Range(Cells(16, 32), Cells(16, 33))).Font.ColorIndex = Range("H16").Font.ColorIndex
    Union(Range(Cells(17, 20), Cells(17, 21)), Range(Cells(17, 32), Cells(17, 33))).Font.ColorIndex = Range("H17").Font.ColorIndex
    Union(Range(Cells(18, 20), Cells(18, 21)), Range(Cells(18, 32), Cells(18, 33))).Font.ColorIndex = Range("H18").Font.ColorIndex
    Union(Range(Cells(19, 20), Cells(19, 21)), Range(Cells(19, 32), Cells(19, 33))).Font.ColorIndex = Range("H19").Font.ColorIndex
    Union(Range(Cells(20, 20), Cells(20, 21)), Range(Cells(20, 32), Cells(20, 33))).Font.ColorIndex = Range("H20").Font.ColorIndex
    Union(Range(Cells(21, 20), Cells(21, 21)), Range(Cells(21, 32), Cells(21, 33))).Font.ColorIndex = Range("H21").Font.ColorIndex
    Union(Range(Cells(22, 20), Cells(22, 21)), Range(Cells(22, 32), Cells(22, 33))).Font.ColorIndex = Range("H22").Font.ColorIndex
    Union(Range(Cells(23, 20), Cells(23, 21)), Range(Cells(23, 32), Cells(23, 33))).Font.ColorIndex = Range("H23").Font.ColorIndex
    Union(Range(Cells(24, 20), Cells(24, 21)), Range(Cells(24, 32), Cells(24, 33))).Font.ColorIndex = Range("H24").Font.ColorIndex
    
    Union(Range(Cells(4, 23), Cells(4, 24)), Range(Cells(4, 35), Cells(4, 36))).Font.ColorIndex = Range("K4").Font.ColorIndex
    Union(Range(Cells(5, 23), Cells(5, 24)), Range(Cells(5, 35), Cells(5, 36))).Font.ColorIndex = Range("K5").Font.ColorIndex
    Union(Range(Cells(6, 23), Cells(6, 24)), Range(Cells(6, 35), Cells(6, 36))).Font.ColorIndex = Range("K6").Font.ColorIndex
    Union(Range(Cells(7, 23), Cells(7, 24)), Range(Cells(7, 35), Cells(7, 36))).Font.ColorIndex = Range("K7").Font.ColorIndex
    Union(Range(Cells(8, 23), Cells(8, 24)), Range(Cells(8, 35), Cells(8, 36))).Font.ColorIndex = Range("K8").Font.ColorIndex
    Union(Range(Cells(9, 23), Cells(9, 24)), Range(Cells(9, 35), Cells(9, 36))).Font.ColorIndex = Range("K9").Font.ColorIndex
    Union(Range(Cells(10, 23), Cells(10, 24)), Range(Cells(10, 35), Cells(10, 36))).Font.ColorIndex = Range("K10").Font.ColorIndex
    Union(Range(Cells(11, 23), Cells(11, 24)), Range(Cells(11, 35), Cells(11, 36))).Font.ColorIndex = Range("K11").Font.ColorIndex
    Union(Range(Cells(12, 23), Cells(12, 24)), Range(Cells(12, 35), Cells(12, 36))).Font.ColorIndex = Range("K12").Font.ColorIndex
    Union(Range(Cells(13, 23), Cells(13, 24)), Range(Cells(13, 35), Cells(13, 36))).Font.ColorIndex = Range("K13").Font.ColorIndex
    Union(Range(Cells(14, 23), Cells(14, 24)), Range(Cells(14, 35), Cells(14, 36))).Font.ColorIndex = Range("K14").Font.ColorIndex
    Union(Range(Cells(15, 23), Cells(15, 24)), Range(Cells(15, 35), Cells(15, 36))).Font.ColorIndex = Range("K15").Font.ColorIndex
    Union(Range(Cells(16, 23), Cells(16, 24)), Range(Cells(16, 35), Cells(16, 36))).Font.ColorIndex = Range("K16").Font.ColorIndex
    Union(Range(Cells(17, 23), Cells(17, 24)), Range(Cells(17, 35), Cells(17, 36))).Font.ColorIndex = Range("K17").Font.ColorIndex
    Union(Range(Cells(18, 23), Cells(18, 24)), Range(Cells(18, 35), Cells(18, 36))).Font.ColorIndex = Range("K18").Font.ColorIndex
    Union(Range(Cells(19, 23), Cells(19, 24)), Range(Cells(19, 35), Cells(19, 36))).Font.ColorIndex = Range("K19").Font.ColorIndex
    Union(Range(Cells(20, 23), Cells(20, 24)), Range(Cells(20, 35), Cells(20, 36))).Font.ColorIndex = Range("K20").Font.ColorIndex
    Union(Range(Cells(21, 23), Cells(21, 24)), Range(Cells(21, 35), Cells(21, 36))).Font.ColorIndex = Range("K21").Font.ColorIndex
    Union(Range(Cells(22, 23), Cells(22, 24)), Range(Cells(22, 35), Cells(22, 36))).Font.ColorIndex = Range("K22").Font.ColorIndex
    Union(Range(Cells(23, 23), Cells(23, 24)), Range(Cells(23, 35), Cells(23, 36))).Font.ColorIndex = Range("K23").Font.ColorIndex
    Union(Range(Cells(24, 23), Cells(24, 24)), Range(Cells(24, 35), Cells(24, 36))).Font.ColorIndex = Range("K24").Font.ColorIndex
   
    End If
    
    
    End Sub

Staple1600 · 5 Octobre 2013

Re : aide à simplifier une macro trop lourde

Bonjour à tous

oliwood
Penses à nous dire bonjour la prochaine fois...

En guise de pénitence, je te laisse chercher quelle partie de ton code, la ligne ci-dessous simplifie

Code:

Range("B4:C25,E4:F25,H4:I25,K4:L25").SpecialCells(xlCellTypeBlanks).Font.ColorIndex = 2

Un petit conseil pour finir: si tu joignais un fichier exemple, je pense que tu aurais plus de réponses, non ?

oliwood · 5 Octobre 2013

Re : aide à simplifier une macro trop lourde

Dsl pour le bonjour c'était mon bon au début du message j'avais hésité à mettre bonjour ou bonsoir et du coup j'ai rien mis mdrrrr
Pour le fichier joint c'est vrai que je pourrais le mettre en pièce jointe mais je dois l'épurer pour cause de confidentialité du boulot...
mais merci de te pencher sur mon cas malgré mon impolitesse involontaire mdrrr

Staple1600 · 5 Octobre 2013

Re : aide à simplifier une macro trop lourde

Re

Bon épurage alors.
On attends ton fichier exemple pour faire des tests d’amaigrissement de code

oliwood · 5 Octobre 2013

Re : aide à simplifier une macro trop lourde

voici le fichier

Staple1600 · 5 Octobre 2013

Re : aide à simplifier une macro trop lourde

Re

Est-ce que ces modifs donnent le même résultat que ton code original

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'si vide alors police blanche
On Error Resume Next
Range("B4:C25,E4:F25,H4:I25,K4:L25").SpecialCells(xlCellTypeBlanks).Font.ColorIndex = 2
'si cellule voulue alors police change de couleur
Select Case Target.Row
Case 4 To 25
If Target.Column Mod 3 = 2 Then
    If Target.Resize(, 2).Font.ColorIndex = 1 Then
    Target.Resize(, 2).Font.ColorIndex = 2
Else
    If Target.Column Mod 3 = 2 Then
    Target.Resize(, 2).Font.ColorIndex = 1
End If
End If
End If
End Select
'mise à zéro des cellules de compteur
 Range("a33").Resize(4) = Empty
'ici laisser le reste du code d'origine
End Sub

mapomme · 5 Octobre 2013

Re : aide à simplifier une macro trop lourde

Bonjour oliwood, Staple1600,

Un essai à vérifier et sans doute encore réductible:

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Const SColonnes = "b/c/e/f/h/i/k/l"
Dim Colonnes, i&, cas&, elem, Plage As Range

Application.ScreenUpdating = True
Colonnes = Split(UCase(SColonnes), "/")
For i = 4 To 25
  For Each elem In Colonnes
    If Range(elem & i) = "" Then Range(elem & i).Font.ColorIndex = 2
  Next elem
Next i

'si cellule voulue alors police change de couleur
For cas = 4 To 25
  For i = 0 To UBound(Colonnes) Step 2
    If Target.Address = "$" & Colonnes(i) & "B$" & cas Then
      If Range(Colonnes(i) & cas & ":" & Colonnes(i + 1) & cas).Font.ColorIndex = 1 Then
        Range(Colonnes(i) & cas & ":" & Colonnes(i + 1) & cas).Font.ColorIndex = 2
      Else
        Range(Colonnes(i) & cas & ":" & Colonnes(i + 1) & cas).Font.ColorIndex = 1
      End If
    End If
  Next i
Next cas
    
'mise à zéro des cellules de compteur
Range("a33:a36") = ""
         
'compte le nombre de cellule à police noire
For cas = 4 To 25
  For i = 0 To UBound(Colonnes) Step 2
     If Range(Colonnes(i) & cas).Font.ColorIndex = 1 Then Range("a33").Offset(i / 2) = Range("a33").Offset(i / 2) + 1
  Next i
Next cas

'différent totaux
Range("c33") = Range("a33") + Range("a34")
Range("c34") = Range("a35") + Range("a36")

'total général
Range("B27") = Range("A33") + Range("A34")
Range("J27") = Range("A35") + Range("A36")
      
Set Plage = Range("A1:AJ30")
If Application.Intersect(Target, Plage) Is Nothing Then
  Exit Sub
Else
  For i = 4 To 25
    Range(Cells(i, 14), Cells(i, 15)).Font.ColorIndex = Range("B" & i).Font.ColorIndex
    Range(Cells(i, 26), Cells(i, 27)).Font.ColorIndex = Range("B" & i).Font.ColorIndex
    Range(Cells(i, 17), Cells(i, 18)).Font.ColorIndex = Range("E" & i).Font.ColorIndex
    Range(Cells(i, 29), Cells(i, 30)).Font.ColorIndex = Range("E" & i).Font.ColorIndex
    Range(Cells(i, 20), Cells(i, 21)).Font.ColorIndex = Range("H" & i).Font.ColorIndex
    Range(Cells(i, 32), Cells(i, 33)).Font.ColorIndex = Range("H" & i).Font.ColorIndex
    Range(Cells(i, 23), Cells(i, 24)).Font.ColorIndex = Range("K" & i).Font.ColorIndex
    Range(Cells(i, 35), Cells(i, 36)).Font.ColorIndex = Range("K" & i).Font.ColorIndex
  Next i
End If

End Sub

oliwood · 6 Octobre 2013

Re : aide à simplifier une macro trop lourde

bonjour et merci de m'aider staples et mapomme
mapomme j'ai testé ton code mais lorsque je clique sur une case la police ne se met pas en blanc même si quand j'efface la case ca se décompte bien du compteur...
Staples j'ai testé comme ca tel quel mais il s epasse rien mais je sais pas si c'est une partie du code ou l'entierté...

mapomme · 6 Octobre 2013

Re : aide à simplifier une macro trop lourde

Bonjour olowood,

Il serait bon de nous expliquer en français ce que vous voulez faire dans chacun des blocs de votre code.

D'autre part, il me semble (mais je me trompe peut-être) que ce type d'écriture est bizarre:

Code:

If Range("B" & cas & ":C" & cas).Font.ColorIndex = 1

En lecture, Range("B" & cas & ":C" & cas).Font.ColorIndex n'est valable que pour un range d'un seul élément et pas pour une plage de cellule.

Que voulez vous faire avec cette instruction ?

oliwood · 6 Octobre 2013

Re : aide à simplifier une macro trop lourde

En effet je vais essayer de m'exprimer clairement sur ce que j'essaye de faire.
le fichier est une liste de gens allant en promenade, les colonnes B, E, H, et K sont les deux premières lettres des noms des personnes et les colonnes C,F,I et L les deux premières lettres des prénoms
le but est d'avoir une liste de départ avec les gens occupant les cellules (colonne D et J) lorsque je clique dans les cases des colonnes de nom (soit B, E,H,K) la police se mette en blanc pour que lorsque j'imprime cela fasse comme si la case était vide, vu que les cellules des colonnes C,F,I et K sont les prénoms si les noms sont mis en blancs la police de la case à côté doit être identique, un exemple: si je clique sur la cellule B4, la police de la cellule B4 devient blanche, la police de la cellule C4 le devient aussi comme ca le nom et prenom de la personne sont en blanc et n'apparaissent pas lors de l'impression de la feuille. Avec cela une macro qui compte directement ("en temps réel" on va dire)combien de cellule ont une police noire avec un total, ce qui m'indique combien de personne sont sorties en promenade car j'aurais enlevé en cliquant sur les cases de noms celles n'y allant pas.
J'espère être clair car ce n'est pas facile à expliquer lol :S
Je sais que pour vous initiés cette macro est bizarre mais c'est la seule idée et manière que j'ai trouvé pour obtenir ce que je souhaite pour le fichier de gestion de la prison ou je bosse, à savoir un petit listing nominatif de ceux qui sont sorti en promenade avec un compteur.
Merci de prendre du temps pour moi en tout cas...

oliwood · 6 Octobre 2013

Re : aide à simplifier une macro trop lourde

D'autre part, il me semble (mais je me trompe peut-être) que ce type d'écriture est bizarre:

Code:

If Range("B" & cas & ":C" & cas).Font.ColorIndex = 1

En lecture, Range("B" & cas & ":C" & cas).Font.ColorIndex n'est valable que pour un range d'un seul élément et pas pour une plage de cellule.

==> cette instruction me sert à dire par exemple si la police de la cellule B4 est mise en blanc la cellule C4 aussi
Il n'ya en fait pas une plage mais 21, plage B4:C4, B5:C5 etc jusque B25:C25.

mapomme · 6 Octobre 2013

Re : aide à simplifier une macro trop lourde

Bonsoir olowood,

Merci pour ces explications. On va essayer d'avancer pas à pas.

@+

oliwood · 6 Octobre 2013

Re : aide à simplifier une macro trop lourde

merci à toi de te pencher sur mon problème surtout lol
j'ai refais mon code avec des meilleures explications sur ce que fait le code

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   'les cases sont vides alors appliquer couleur police blanche

For i = 4 To 25
     If Range("B" & i) = "" Then Range("B" & i).Font.ColorIndex = 2
     If Range("C" & i) = "" Then Range("C" & i).Font.ColorIndex = 2
     If Range("E" & i) = "" Then Range("E" & i).Font.ColorIndex = 2
     If Range("F" & i) = "" Then Range("F" & i).Font.ColorIndex = 2
     If Range("H" & i) = "" Then Range("H" & i).Font.ColorIndex = 2
     If Range("I" & i) = "" Then Range("I" & i).Font.ColorIndex = 2
     If Range("K" & i) = "" Then Range("K" & i).Font.ColorIndex = 2
     If Range("L" & i) = "" Then Range("L" & i).Font.ColorIndex = 2

Next
'si clic sur cellule,police blanche appliquée à la cellule +faire pareil à la cellule colonne suivante
For cas = 4 To 25
     If Target.Address = "$B$" & cas Then
        If Range("B" & cas & ":C" & cas).Font.ColorIndex = 1 Then
          Range("B" & cas & ":C" & cas).Font.ColorIndex = 2
        
         Else
           Range("B" & cas & ":C" & cas).Font.ColorIndex = 1
         End If
        End If
        
      If Target.Address = "$E$" & cas Then
        If Range("E" & cas & ":F" & cas).Font.ColorIndex = 1 Then
          Range("E" & cas & ":F" & cas).Font.ColorIndex = 2
         Else
           Range("E" & cas & ":F" & cas).Font.ColorIndex = 1
         End If
        End If
        
        If Target.Address = "$H$" & cas Then
        If Range("H" & cas & ":I" & cas).Font.ColorIndex = 1 Then
          Range("H" & cas & ":I" & cas).Font.ColorIndex = 2
        
         Else
           Range("H" & cas & ":I" & cas).Font.ColorIndex = 1
         End If
        End If
        
        If Target.Address = "$K$" & cas Then
        If Range("K" & cas & ":L" & cas).Font.ColorIndex = 1 Then
          Range("K" & cas & ":L" & cas).Font.ColorIndex = 2
        
         Else
           Range("K" & cas & ":L" & cas).Font.ColorIndex = 1
         End If
        End If
        
    Next
    'mise à zéro des cellules compteur
         Range("a33") = ""
         Range("a34") = ""
         Range("a35") = ""
         Range("a36") = ""
        
         
     'compte le nombre de cellule à police noire
     For i = 4 To 25
          If Range("B" & i).Font.ColorIndex = 1 Then Range("a33") = Range("a33") + 1
          If Range("E" & i).Font.ColorIndex = 1 Then Range("a34") = Range("a34") + 1
          If Range("H" & i).Font.ColorIndex = 1 Then Range("a35") = Range("a35") + 1
          If Range("K" & i).Font.ColorIndex = 1 Then Range("a36") = Range("a36") + 1
          
     Next
    'différent totaux
      Range("c33") = Range("a33") + Range("a34")
      Range("c34") = Range("a35") + Range("a36")

      'total général
      Range("B27") = Range("A33") + Range("A34")
      Range("J27") = Range("A35") + Range("A36")
      
      Dim Plage As Range
    
    Set Plage = Range("A1:AJ30")
    
    If Application.Intersect(Target, Plage) Is Nothing Then
    Exit Sub
    Else
    'appliquer aux cellules des colonnes équivalentes la même policequelacellule du premier tableau
    Union(Range(Cells(4, 14), Cells(4, 15)), Range(Cells(4, 26), Cells(4, 27))).Font.ColorIndex = Range("B4").Font.ColorIndex
    Union(Range(Cells(5, 14), Cells(5, 15)), Range(Cells(5, 26), Cells(5, 27))).Font.ColorIndex = Range("B5").Font.ColorIndex
    Union(Range(Cells(6, 14), Cells(6, 15)), Range(Cells(6, 26), Cells(6, 27))).Font.ColorIndex = Range("B6").Font.ColorIndex
    Union(Range(Cells(7, 14), Cells(7, 15)), Range(Cells(7, 26), Cells(7, 27))).Font.ColorIndex = Range("B7").Font.ColorIndex
    Union(Range(Cells(8, 14), Cells(8, 15)), Range(Cells(8, 26), Cells(8, 27))).Font.ColorIndex = Range("B8").Font.ColorIndex
    Union(Range(Cells(9, 14), Cells(9, 15)), Range(Cells(9, 26), Cells(9, 27))).Font.ColorIndex = Range("B9").Font.ColorIndex
    Union(Range(Cells(10, 14), Cells(10, 15)), Range(Cells(10, 26), Cells(10, 27))).Font.ColorIndex = Range("B10").Font.ColorIndex
    Union(Range(Cells(11, 14), Cells(11, 15)), Range(Cells(11, 26), Cells(11, 27))).Font.ColorIndex = Range("B11").Font.ColorIndex
    Union(Range(Cells(12, 14), Cells(12, 15)), Range(Cells(12, 26), Cells(12, 27))).Font.ColorIndex = Range("B12").Font.ColorIndex
    Union(Range(Cells(13, 14), Cells(13, 15)), Range(Cells(13, 26), Cells(13, 27))).Font.ColorIndex = Range("B13").Font.ColorIndex
    Union(Range(Cells(14, 14), Cells(14, 15)), Range(Cells(14, 26), Cells(14, 27))).Font.ColorIndex = Range("B14").Font.ColorIndex
    Union(Range(Cells(15, 14), Cells(15, 15)), Range(Cells(15, 26), Cells(15, 27))).Font.ColorIndex = Range("B15").Font.ColorIndex
    Union(Range(Cells(16, 14), Cells(16, 15)), Range(Cells(16, 26), Cells(16, 27))).Font.ColorIndex = Range("B16").Font.ColorIndex
    Union(Range(Cells(17, 14), Cells(17, 15)), Range(Cells(17, 26), Cells(17, 27))).Font.ColorIndex = Range("B17").Font.ColorIndex
    Union(Range(Cells(18, 14), Cells(18, 15)), Range(Cells(18, 26), Cells(18, 27))).Font.ColorIndex = Range("B18").Font.ColorIndex
    Union(Range(Cells(19, 14), Cells(19, 15)), Range(Cells(19, 26), Cells(19, 27))).Font.ColorIndex = Range("B19").Font.ColorIndex
    Union(Range(Cells(20, 14), Cells(20, 15)), Range(Cells(20, 26), Cells(20, 27))).Font.ColorIndex = Range("B20").Font.ColorIndex
    Union(Range(Cells(21, 14), Cells(21, 15)), Range(Cells(21, 26), Cells(21, 27))).Font.ColorIndex = Range("B21").Font.ColorIndex
    Union(Range(Cells(22, 14), Cells(22, 15)), Range(Cells(22, 26), Cells(22, 27))).Font.ColorIndex = Range("B22").Font.ColorIndex
    Union(Range(Cells(23, 14), Cells(23, 15)), Range(Cells(23, 26), Cells(23, 27))).Font.ColorIndex = Range("B23").Font.ColorIndex
    Union(Range(Cells(24, 14), Cells(24, 15)), Range(Cells(24, 26), Cells(24, 27))).Font.ColorIndex = Range("B24").Font.ColorIndex
    Union(Range(Cells(25, 14), Cells(25, 15)), Range(Cells(25, 26), Cells(25, 27))).Font.ColorIndex = Range("B25").Font.ColorIndex
    Union(Range(Cells(4, 17), Cells(4, 18)), Range(Cells(4, 29), Cells(4, 30))).Font.ColorIndex = Range("E4").Font.ColorIndex
    Union(Range(Cells(5, 17), Cells(5, 18)), Range(Cells(5, 29), Cells(5, 30))).Font.ColorIndex = Range("E5").Font.ColorIndex
    Union(Range(Cells(6, 17), Cells(6, 18)), Range(Cells(6, 29), Cells(6, 30))).Font.ColorIndex = Range("E6").Font.ColorIndex
    Union(Range(Cells(7, 17), Cells(7, 18)), Range(Cells(7, 29), Cells(7, 30))).Font.ColorIndex = Range("E7").Font.ColorIndex
    Union(Range(Cells(8, 17), Cells(8, 18)), Range(Cells(8, 29), Cells(8, 30))).Font.ColorIndex = Range("E8").Font.ColorIndex
    Union(Range(Cells(9, 17), Cells(9, 18)), Range(Cells(9, 29), Cells(9, 30))).Font.ColorIndex = Range("E9").Font.ColorIndex
    Union(Range(Cells(10, 17), Cells(10, 18)), Range(Cells(10, 29), Cells(10, 30))).Font.ColorIndex = Range("E10").Font.ColorIndex
    Union(Range(Cells(11, 17), Cells(11, 18)), Range(Cells(11, 29), Cells(11, 30))).Font.ColorIndex = Range("E11").Font.ColorIndex
    Union(Range(Cells(12, 17), Cells(12, 18)), Range(Cells(12, 29), Cells(12, 30))).Font.ColorIndex = Range("E12").Font.ColorIndex
    Union(Range(Cells(13, 17), Cells(13, 18)), Range(Cells(13, 29), Cells(13, 30))).Font.ColorIndex = Range("E13").Font.ColorIndex
    Union(Range(Cells(14, 17), Cells(14, 18)), Range(Cells(14, 29), Cells(14, 30))).Font.ColorIndex = Range("E14").Font.ColorIndex
    Union(Range(Cells(15, 17), Cells(15, 18)), Range(Cells(15, 29), Cells(15, 30))).Font.ColorIndex = Range("E15").Font.ColorIndex
    Union(Range(Cells(16, 17), Cells(16, 18)), Range(Cells(16, 29), Cells(16, 30))).Font.ColorIndex = Range("E16").Font.ColorIndex
    Union(Range(Cells(17, 17), Cells(17, 18)), Range(Cells(17, 29), Cells(17, 30))).Font.ColorIndex = Range("E17").Font.ColorIndex
    Union(Range(Cells(18, 17), Cells(18, 18)), Range(Cells(18, 29), Cells(18, 30))).Font.ColorIndex = Range("E18").Font.ColorIndex
    Union(Range(Cells(19, 17), Cells(19, 18)), Range(Cells(19, 29), Cells(19, 30))).Font.ColorIndex = Range("E19").Font.ColorIndex
    Union(Range(Cells(20, 17), Cells(20, 18)), Range(Cells(20, 29), Cells(20, 30))).Font.ColorIndex = Range("E20").Font.ColorIndex
    Union(Range(Cells(21, 17), Cells(21, 18)), Range(Cells(21, 29), Cells(21, 30))).Font.ColorIndex = Range("E21").Font.ColorIndex
    Union(Range(Cells(22, 17), Cells(22, 18)), Range(Cells(22, 29), Cells(22, 30))).Font.ColorIndex = Range("E22").Font.ColorIndex
    Union(Range(Cells(23, 17), Cells(23, 18)), Range(Cells(23, 29), Cells(23, 30))).Font.ColorIndex = Range("E23").Font.ColorIndex
    Union(Range(Cells(24, 17), Cells(24, 18)), Range(Cells(24, 29), Cells(24, 30))).Font.ColorIndex = Range("E24").Font.ColorIndex
    Union(Range(Cells(25, 17), Cells(25, 18)), Range(Cells(25, 29), Cells(25, 30))).Font.ColorIndex = Range("E25").Font.ColorIndex
    
    Union(Range(Cells(4, 20), Cells(4, 21)), Range(Cells(4, 32), Cells(4, 33))).Font.ColorIndex = Range("H4").Font.ColorIndex
    Union(Range(Cells(5, 20), Cells(5, 21)), Range(Cells(5, 32), Cells(5, 33))).Font.ColorIndex = Range("H5").Font.ColorIndex
    Union(Range(Cells(6, 20), Cells(6, 21)), Range(Cells(6, 32), Cells(6, 33))).Font.ColorIndex = Range("H6").Font.ColorIndex
    Union(Range(Cells(7, 20), Cells(7, 21)), Range(Cells(7, 32), Cells(7, 33))).Font.ColorIndex = Range("H7").Font.ColorIndex
    Union(Range(Cells(8, 20), Cells(8, 21)), Range(Cells(8, 32), Cells(8, 33))).Font.ColorIndex = Range("H8").Font.ColorIndex
    Union(Range(Cells(9, 20), Cells(9, 21)), Range(Cells(9, 32), Cells(9, 33))).Font.ColorIndex = Range("H9").Font.ColorIndex
    Union(Range(Cells(10, 20), Cells(10, 21)), Range(Cells(10, 32), Cells(10, 33))).Font.ColorIndex = Range("H10").Font.ColorIndex
    Union(Range(Cells(11, 20), Cells(11, 21)), Range(Cells(11, 32), Cells(11, 33))).Font.ColorIndex = Range("H11").Font.ColorIndex
    Union(Range(Cells(12, 20), Cells(12, 21)), Range(Cells(12, 32), Cells(12, 33))).Font.ColorIndex = Range("H12").Font.ColorIndex
    Union(Range(Cells(13, 20), Cells(13, 21)), Range(Cells(13, 32), Cells(13, 33))).Font.ColorIndex = Range("H13").Font.ColorIndex
    Union(Range(Cells(14, 20), Cells(14, 21)), Range(Cells(14, 32), Cells(14, 33))).Font.ColorIndex = Range("H14").Font.ColorIndex
    Union(Range(Cells(15, 20), Cells(15, 21)), Range(Cells(15, 32), Cells(15, 33))).Font.ColorIndex = Range("H15").Font.ColorIndex
    Union(Range(Cells(16, 20), Cells(16, 21)), Range(Cells(16, 32), Cells(16, 33))).Font.ColorIndex = Range("H16").Font.ColorIndex
    Union(Range(Cells(17, 20), Cells(17, 21)), Range(Cells(17, 32), Cells(17, 33))).Font.ColorIndex = Range("H17").Font.ColorIndex
    Union(Range(Cells(18, 20), Cells(18, 21)), Range(Cells(18, 32), Cells(18, 33))).Font.ColorIndex = Range("H18").Font.ColorIndex
    Union(Range(Cells(19, 20), Cells(19, 21)), Range(Cells(19, 32), Cells(19, 33))).Font.ColorIndex = Range("H19").Font.ColorIndex
    Union(Range(Cells(20, 20), Cells(20, 21)), Range(Cells(20, 32), Cells(20, 33))).Font.ColorIndex = Range("H20").Font.ColorIndex
    Union(Range(Cells(21, 20), Cells(21, 21)), Range(Cells(21, 32), Cells(21, 33))).Font.ColorIndex = Range("H21").Font.ColorIndex
    Union(Range(Cells(22, 20), Cells(22, 21)), Range(Cells(22, 32), Cells(22, 33))).Font.ColorIndex = Range("H22").Font.ColorIndex
    Union(Range(Cells(23, 20), Cells(23, 21)), Range(Cells(23, 32), Cells(23, 33))).Font.ColorIndex = Range("H23").Font.ColorIndex
    Union(Range(Cells(24, 20), Cells(24, 21)), Range(Cells(24, 32), Cells(24, 33))).Font.ColorIndex = Range("H24").Font.ColorIndex
    
    Union(Range(Cells(4, 23), Cells(4, 24)), Range(Cells(4, 35), Cells(4, 36))).Font.ColorIndex = Range("K4").Font.ColorIndex
    Union(Range(Cells(5, 23), Cells(5, 24)), Range(Cells(5, 35), Cells(5, 36))).Font.ColorIndex = Range("K5").Font.ColorIndex
    Union(Range(Cells(6, 23), Cells(6, 24)), Range(Cells(6, 35), Cells(6, 36))).Font.ColorIndex = Range("K6").Font.ColorIndex
    Union(Range(Cells(7, 23), Cells(7, 24)), Range(Cells(7, 35), Cells(7, 36))).Font.ColorIndex = Range("K7").Font.ColorIndex
    Union(Range(Cells(8, 23), Cells(8, 24)), Range(Cells(8, 35), Cells(8, 36))).Font.ColorIndex = Range("K8").Font.ColorIndex
    Union(Range(Cells(9, 23), Cells(9, 24)), Range(Cells(9, 35), Cells(9, 36))).Font.ColorIndex = Range("K9").Font.ColorIndex
    Union(Range(Cells(10, 23), Cells(10, 24)), Range(Cells(10, 35), Cells(10, 36))).Font.ColorIndex = Range("K10").Font.ColorIndex
    Union(Range(Cells(11, 23), Cells(11, 24)), Range(Cells(11, 35), Cells(11, 36))).Font.ColorIndex = Range("K11").Font.ColorIndex
    Union(Range(Cells(12, 23), Cells(12, 24)), Range(Cells(12, 35), Cells(12, 36))).Font.ColorIndex = Range("K12").Font.ColorIndex
    Union(Range(Cells(13, 23), Cells(13, 24)), Range(Cells(13, 35), Cells(13, 36))).Font.ColorIndex = Range("K13").Font.ColorIndex
    Union(Range(Cells(14, 23), Cells(14, 24)), Range(Cells(14, 35), Cells(14, 36))).Font.ColorIndex = Range("K14").Font.ColorIndex
    Union(Range(Cells(15, 23), Cells(15, 24)), Range(Cells(15, 35), Cells(15, 36))).Font.ColorIndex = Range("K15").Font.ColorIndex
    Union(Range(Cells(16, 23), Cells(16, 24)), Range(Cells(16, 35), Cells(16, 36))).Font.ColorIndex = Range("K16").Font.ColorIndex
    Union(Range(Cells(17, 23), Cells(17, 24)), Range(Cells(17, 35), Cells(17, 36))).Font.ColorIndex = Range("K17").Font.ColorIndex
    Union(Range(Cells(18, 23), Cells(18, 24)), Range(Cells(18, 35), Cells(18, 36))).Font.ColorIndex = Range("K18").Font.ColorIndex
    Union(Range(Cells(19, 23), Cells(19, 24)), Range(Cells(19, 35), Cells(19, 36))).Font.ColorIndex = Range("K19").Font.ColorIndex
    Union(Range(Cells(20, 23), Cells(20, 24)), Range(Cells(20, 35), Cells(20, 36))).Font.ColorIndex = Range("K20").Font.ColorIndex
    Union(Range(Cells(21, 23), Cells(21, 24)), Range(Cells(21, 35), Cells(21, 36))).Font.ColorIndex = Range("K21").Font.ColorIndex
    Union(Range(Cells(22, 23), Cells(22, 24)), Range(Cells(22, 35), Cells(22, 36))).Font.ColorIndex = Range("K22").Font.ColorIndex
    Union(Range(Cells(23, 23), Cells(23, 24)), Range(Cells(23, 35), Cells(23, 36))).Font.ColorIndex = Range("K23").Font.ColorIndex
    Union(Range(Cells(24, 23), Cells(24, 24)), Range(Cells(24, 35), Cells(24, 36))).Font.ColorIndex = Range("K24").Font.ColorIndex
   
    End If
    
    
    End Sub

mapomme · 6 Octobre 2013

Re : aide à simplifier une macro trop lourde

(re)

Voici un nouvel essai. Je n'ai pas encore touché au dernier bloc (série des UNION).
Est ce que cet essai répond plus à vos besoins ?

(j'ai utilisé une fonction ColonneDans dont le code et les explications se trouvent dans Module1)

mapomme · 7 Octobre 2013

Re : aide à simplifier une macro trop lourde

(re)

Voici un nouvel essai avec le traitement des blocs UNION. Est ce que OK ?

nb: il reste un problème avec les cellules correspondant au trio. En effet, la police des deux cellules vides vient interférer avec le calcul des totaux. Je verrai plus tard...

aide à simplifier une macro trop lourde

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

Partager cette page

Statistiques des forums