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

mapomme · 7 Octobre 2013

Re : aide à simplifier une macro trop lourde

(re)

Voici un nouvel essai avec la résolution du PB des cellules vides pour le trio. La procédure d'initialisation a été aussi modifiée.

Est ce mieux ?

ROGER2327 · 7 Octobre 2013

Re : aide à simplifier une macro trop lourde

Bonjour à tous.

Un autre essai (à tester !) :

VB:

Private Sub Worksheet_SelectionChange(ByVal Cible As Range)
Dim i As Byte, j As Byte, k As Byte, n As Byte, c() As Byte, col(), Plg As Range '
    col = Array(2, 5, 8, 11) 'Colonnes des noms
    n = UBound(col) '
    Set Plg = Cells(4, col(0)).Resize(22) '
    For j = 1 To n: Set Plg = Union(Plg, Cells(4, col(j)).Resize(22)): Next '
    If Not Intersect(Cible, Plg) Is Nothing Then '
        Application.ScreenUpdating = False '
        ReDim c(n) '
        For i = 4 To 25: For j = 0 To n '
            With Cells(i, col(j)) '
                If .Value = "" Then '
                    .Resize(, 2).Font.ColorIndex = 2 'si vide alors police blanche
                ElseIf Not Intersect(Cible, .Cells) Is Nothing Then '
                    .Resize(, 2).Font.ColorIndex = 2 + (.Font.ColorIndex = 2) 'si cellule voulue alors police change de couleur
                    For k = 1 To 2: .Offset(, 12 * k).Resize(, 2).Font.ColorIndex = .Font.ColorIndex: Next 'Tout le bazar des "Union(...)"
                End If '
                c(j) = c(j) - (.Font.ColorIndex = 1) 'compte le nombre de cellule à police noire
            End With '
        Next j, i '
    'total général
        Range("B27") = c(0) + c(1) '
        Range("J27") = c(2) + c(3) '
        Application.ScreenUpdating = True '
    End If
End Sub

Bonne nuit !

ROGER2327
#6873

Lundi 2 Haha 141 (Dissolution de Edgar Poe, dinomythurge - fête Suprême Quarte)
16 Vendémiaire An CCXXII, 0,1881h - belle-de-nuit
2013-W41-1T00:27:05Z

oliwood · 7 Octobre 2013

Re : aide à simplifier une macro trop lourde

waw super ça marche nickel c'est trop compliqué pour moi pour comprendre toute la simplification mais ça marche tip top et ca fait moins ramer excel !!!

Par contre le problème des totaux je ne comprends pas si tu parles de la ligne 25 qui n'existe pas dans le tableau "aile B" comme les cellules sont vides la police est mise en blanche donc pas comptées et cet espace ne sera jamais rempli, à moins de transformer la prison et sa structure mdr
Sinon dans ma macro réinitialiser j'avais détourné le problème en trichant en faisant -3 au total, c'est pas académique mais ça marchait

En tout cas un grand merci de m'avoir aidé, vu les modifications à l'arrivée je n'y serais pas parvenu du moins pas avant quelques mois voire années...

ROGER2327 · 7 Octobre 2013

Re : aide à simplifier une macro trop lourde

Re...

oliwood à dit:
waw super ça marche nickel (...)

Tant mieux ! Mais "ça", qu'est-ce ?

J'ai revu l'ensemble de la feuille (notamment la procédure de réinitialisation). Je joins la chose.

Bonne journée.

ROGER2327
#6874

Lundi 2 Haha 141 (Dissolution de Edgar Poe, dinomythurge - fête Suprême Quarte)
16 Vendémiaire An CCXXII, 4,5386h - belle-de-nuit
2013-W41-1T10:53:34Z

oliwood · 7 Octobre 2013

Re : aide à simplifier une macro trop lourde

au départ le fichier de mapomme... ton message n'apparaissait pas encore chez moi bizarre vu les heures mais bon ...
Le tiens est super et encore plus court roger et de la mise en page en plus merci bcp !!!
Chose étrange celui de roger j'ai su l'insérer dans mon fichier et pas de problème tandis que celui de mapomme j'ai eu une erreur de fonction non définie avec le mot DansColonne sinon j'aurais eu du mal à choisir, les deux étant du bon boulot.
Grand merci de l'aide en tout cas quand j'aurais fini mes collègues et moi verrons notre boulot vachement simplifié !!

mapomme · 7 Octobre 2013

Re : aide à simplifier une macro trop lourde

Bonsoir oliwood, ROGER2327,

J'allais vous proposer une nouvelle version plus concise quand j'ai vu celle de ROGER2337 (que je salue ). Je me suis donc abstenu n'ayant guère l'espoir de faire plus court .

oliwood à dit:
(...) celui de mapomme j'ai eu une erreur de fonction non définie avec le mot DansColonne

En fait, si vous reprenez la dernière version de mon fichier, vous devez voir dans l'explorateur de projet un module nommé Module1. Dans module1, se trouve le code de la fonction DansColonne. Il suffit dans votre projet de créer un module puis d'y coller le code de la fonction DansColonne de mon fichier vers le nouveau module que vous avez créé dans votre projet.

Ou bien, copiez directement le code de la fonction DansColonne de mon fichier et collez le à la fin du code de votre fichier (sans création d'un nouveau module). Cela devrait aussi fonctionner.

oliwood · 9 Octobre 2013

Re : aide à simplifier une macro trop lourde

Effectivement mapomme je n'avais pas vu le module autant pour moi et encore un grand merci de votre aide, je peux enfin passer à la prochaine étape de mon fichier grâce à vous deux

oliwood · 9 Octobre 2013

Re : aide à simplifier une macro trop lourde

Rebonjour et sans vouloir abuser de votre aide...
Dans le même genre de code depuis que mon fichier s'est étoffé (avec votre aide et de nouvelles feuilles) j'ai un événement qui rame sur deux feuilles (même événement).
Je voudrais votre avis éclairé sur mon code VBA...je suppose qu'il est simplifiable ou améliorable aussi

PS j'ai essayé de clairement indiquer ce que fait quoi et l'action souhaitée. Cela marche mais ca rame
PS 2 fournir le fichier est compliqué vu la confidentialité ( c'est pour le boulot et je travaille en prison...) mais je vais essayer de bidouiller et changer les noms.

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'si case m correspondante à la case D > 1 (au cachot si un nombre est dedans)
'alors intérieur D et E en rouge et pas comptée dans total population
For cas = 10 To 67
If Range("M" & cas).Value > 1 Then
Range("D" & cas).Interior.ColorIndex = 3
Range("D" & cas).Font.ColorIndex = 2
Range("E" & cas).Interior.ColorIndex = 3
Range("E" & cas).Font.ColorIndex = 2
Else: 'sinon normal police noire et fond blanc
Range("D" & cas).Interior.ColorIndex = 2
Range("D" & cas).Font.ColorIndex = 1
Range("E" & cas).Interior.ColorIndex = 2
Range("E" & cas).Font.ColorIndex = 1
End If
Next
'si cellule dans plage 1 vide alors police blanche
For i = 10 To 67
     If Range("D" & i) = "" Then Range("D" & i).Font.ColorIndex = 1
Next
'mise à zéro total "population" et compteurs
Range("F2").Value = ""
sommeNoire = 0
compterNoire = 0
For i = 10 To 67
     If Range("D" & i) = "" Then Range("D" & i).Font.ColorIndex = 2
Next
'plage1 de cellule à compter pour calculer la population
For Each cell In ActiveSheet.Range("D10:D67")
If cell.Font.Color = vbBlack Then 'black = couleur noire
On Error Resume Next
sommeNoire = sommeNoire + cell.Value
On Error GoTo 0
compterNoire = compterNoire + 1
End If
Next
If compterNoire = 1 Then c = "cellule" Else c = "cellules"
Range("F2").Value = compterNoire  'Affiche compteur en F2
For i = 10 To 67
     If Range("D" & i) = "" Then Range("D" & i).Font.ColorIndex = 1
Next
'plage2 de cellule à compter pour calculer la population
For i = 6 To 7
If Range("D" & i) <> "" Then
Range("F2").Value = Range("F2").Value + 1
End If
Next
End Sub

mapomme · 9 Octobre 2013

Re : aide à simplifier une macro trop lourde

Bonsoir oliwood,

Pour:

(...) Cela marche mais ca rame (...)

En début de code avant l'instruction For cas = 10 To 67, insérez l'instruction:Application.ScreenUpdating = False

et, en fin de code avant l'instruction End Sub, insérez l'instruction:Application.ScreenUpdating = True

oliwood · 10 Octobre 2013

Re : aide à simplifier une macro trop lourde

merci mapomme
hier aprem j'ai justement trouvé le screenupdating et cela ne change rien à mon problème, le fichier se bloque et rame pendant 4-5 secondes... j'ai trouvé aussi le code Application.Calculation = xlCalculationManual et remettre en automatique à la fin pour tenter d'optimiser mais tjs pareil ^^
Je soupçonne une boucle ou qqch qui rempli la mémoire ?
Pffff je bloque

aide à simplifier une macro trop lourde

oliwood

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

Pièces jointes

ROGER2327

XLDnaute Barbatruc

oliwood

XLDnaute Nouveau

ROGER2327

XLDnaute Barbatruc

Pièces jointes

oliwood

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

oliwood

XLDnaute Nouveau

oliwood

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

oliwood

XLDnaute Nouveau

Discussions similaires