Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 somme couleur colonnes

teddy33130

XLDnaute Nouveau
bonjour a tous
j'ai une base de données avec 500 lignes (pour l'instant)
je cherche a faire une addition des cellules en fonction de leur couleur (il y en a deux , blanc ou vert)
en bas de ma base de données
mais bien sur au fur et a mesure que ma base de données s'alimente les cellule contenant les formules vont se decaler vers le bas car j'insere ma nouvelle ligne en ligne 2
en ligne 1 j'ai les entete des colonnes
esperant avoir ete clair
amicalement
 
Solution
Un essai en PJ à bien vérifier.

1- Création d'une feuille X ( que j'ai initialisée avec InitPageXcouleur ). Cette feuille est mis en xlSheetVeryHidden pour n'être jamais visible.
Le but est que chaque fois qu'on touche à Base de données on fait exactement la même chose dans X. Si on met vert alors on met V dans X, si on insère une ligne, on fait pareil dans X. A tout moment une cellule en LC dans base à son équivalent couleur dans X. Je ne met que V pour vert, le reste étant blanc il n'est pas nécessaire de le préciser.
2- Dans le code :
a- A chaque fois qu'on insère une ligne, on fait pareil dans X :
VB:
        With Feuil3
            .Rows("2:2").Insert T2 = xlDown, CopyOrigin:=xlFormatFromLeftOrAbove    'insere une ligne a la ligne...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Si le problème est toujours là. Il faut utiliser les grands moyens.
La Fonction est trop lourde. Dans votre fichier il y a 60 fonctions à exécuter sur 500 lignes.
Donc il y a un autre moyen. On créé une variable publique ( Flag par ex ).
Dans la fonction si Flag=0 on sort, si Flag=1 on exécute la fonction.
VB:
Public Flag
Function SOMMECOUL(plage As Range)
    Application.Volatile
    If Flag = 0 Then Exit Function
    Dim c As Range, coul As Long, tot
    coul = Range(Application.Caller.Address).Interior.Color
    For Each c In plage
        If c.Interior.Color = coul Then
            If IsNumeric(c.Value) Then tot = tot + c.Value
        End If
    Next c
    SOMMECOUL = tot
End Function
Quand vous entrez dans votre userform vous faites Flag=0, donc interdiction d'exécuter les fonctions.
Et tout à la fin du userform vous faites :
Code:
    Flag = 1
    Calculate
    Flag = 0
End Sub
Donc on remet à jour toute la feuille puis on ré interdit les fonctions.



Sinon il faut trouver autre chose que la couleur pour différencier les données. Par ex.
On créé une feuille nommée XXX. Vous modifiez votre macro :
Code:
For i = 1 To 30
    .Cells(2, i + 3) = Controls("TV" & i)
    If .Cells(2, i + 3) > "" Then .Cells(2, i + 3) = Replace(.Cells(2, i + 3), ".", ",") * 1    ' remplace les . par des ,& multiplie par 1
    If .Cells(2, i + 3) > "" Then .Cells(2, i + 3) = .Cells(2, i + 3) * 1: .Cells(2, i + 3).NumberFormat = "0.000"    'met le formet 0.000
    If Controls("ch" & i) = True Then
        .Cells(2, i + 3).Interior.Color = RGB(192, 255, 96)
        Sheets("XXX").Cells(2, i + 3) = "V"
    Else
        Sheets("XXX").Cells(2, i + 3) = "B"
    End If
Next
Donc vous avez deux tableau, l'actuel avec des valeurs et son miroir où dans les mêmes cellules vous avez B ou V.
Dans ce cas les formules deviennent très simples :
Code:
=SOMME.SI('XXX'!D2:D37;"V";Feuil1!D2:D37)
et
=SOMME.SI('XXX)'!D2:D37;"B";Feuil1!D2:D37)
Car en fait ce qui est lent c'est la lecture de la couleur des cellules. Vous avez beaucoup trop de cellules à analyser. ( 15000 )

En PJ une maquette. Rajouter une feuille n'est pas bien important, mais vous n'avez plus votre fonction SOMMECOUL et vous retrouver la rapidité du départ.
 

Pièces jointes

  • test couleur maquette.xlsm
    26.8 KB · Affichages: 6
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
Pour en avoir le cœur net j'ai fait un petit test, voir PJ.

Même structure que votre fichier 2 formules par colonne, 35 colonnes, 500 lignes.
La macro fait la même chose que votre fonction mais d'un seul coup, et on mesure le temps.
Sur mon PC qui est assez véloce ça prend entre 1.3 et 1.5 seconde.
En d'autre termes à chaque fois que vous recalculerez votre fichier ça va freezer 1.5s.
( en fait si on supprime coul = Cells(L, c).Interior.Color alors on passe à 0.7s )

En d'autre termes cette méthode de calcul n'est pas applicable à votre fichier. Sorry.
Reste, je pense, que la solution du post précédent avec une "feuille miroir", ou tout autre système permettant de différencier les couleurs sans regarder les couleurs.
 

Pièces jointes

  • TestCoul.xlsm
    90.2 KB · Affichages: 3

sylvanu

XLDnaute Barbatruc
Supporter XLD
Un essai en PJ à bien vérifier.

1- Création d'une feuille X ( que j'ai initialisée avec InitPageXcouleur ). Cette feuille est mis en xlSheetVeryHidden pour n'être jamais visible.
Le but est que chaque fois qu'on touche à Base de données on fait exactement la même chose dans X. Si on met vert alors on met V dans X, si on insère une ligne, on fait pareil dans X. A tout moment une cellule en LC dans base à son équivalent couleur dans X. Je ne met que V pour vert, le reste étant blanc il n'est pas nécessaire de le préciser.
2- Dans le code :
a- A chaque fois qu'on insère une ligne, on fait pareil dans X :
VB:
        With Feuil3
            .Rows("2:2").Insert T2 = xlDown, CopyOrigin:=xlFormatFromLeftOrAbove    'insere une ligne a la ligne 2
            Sheets("X").Rows("2:2").Insert T2 = xlDown, CopyOrigin:=xlFormatFromLeftOrAbove    'insere une ligne a la ligne 2 feuille X
b- A chaque fois qu'on met une cellule en vert, on met V dans la même cellule de la feuille X
Code:
.Cells(2, i + 40).Interior.Color = RGB(192, 255, 96)
' V dans même cellule feuille X
Sheets("X").Cells(Ligne, i + 40) = "V"
c- Le "Total vert" devient simplement :
Code:
=SOMME.SI(X!D:D;"V";D$1:D496)
Le "Total blanc" est simplement le Toital moins le Total vert. :
Code:
=D497-D498

( Pour trouver les modifs dans le code, il suffit de faire une recherche sur Sheets("X") )
 

Pièces jointes

  • test v68 V2.xlsm
    278.9 KB · Affichages: 3

teddy33130

XLDnaute Nouveau
re
merci pour tout car avec les essais que je vient de faire cela fonctionne
je testerais plus demain (RV oblige)
mais je suis confiant avec les essais que j'ai fait
je te tien au courant si j'ai un probleme
et je te remerci grandement pour tout le temps que tu m'a accordé
amicalement
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…