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

XL 2010 somme couleur colonnes

T

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...
Trier par date Trier par votes

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:
Vote positif 0 Vote négatif

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
Vote positif 0 Vote négatif

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
Vote positif 0 Vote négatif
Solution
T

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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

S
  • Question
XL 2016 Transposer colonnes sur lignes
2 3
Réponses
32
Affichages
1 K
soumus
S
M
  • Question
XL 2019 A partir des base de données 1 et 2, comment obtenir la base de données 3 sur 2 colonnes avec uniquement des formules excel, en automatique
2
Réponses
16
Affichages
499
Mika_56
M
  • Question
XL 2019 Problème avec INDEX & EQUIV
Réponses
8
Affichages
257
Titof06
L
  • Question
XL pour MAC tableau ans perturbation des colonnes non copié
Réponses
5
Affichages
590
DJunqueira
D
  • Question
XL 2021 Fonction RechercheX dispo.. mais en fait non...
Réponses
9
Affichages
345
djidji59430
  • Résolu(e)
Microsoft 365 Tableau de STATS sur autre feuille
Réponses
8
Affichages
324
AtTheOne
F
  • Résolu(e)
Microsoft 365 Copier juste couleur cellule.
Réponses
7
Affichages
531
Francky79
F
A
  • Question
Microsoft 365 Macro pour récupérer des colonnes qui ne sont pas conjointes
Réponses
4
Affichages
163
Anthony_51
A
M
  • Question
Microsoft 365 Afficher les données d'un userform sur un autre userform
Réponses
3
Affichages
430
Manon71.
M
X
  • Question
XL 2016 Gestion RH (renvoie de la valeur de la premier cellule d'une liste quand en fin de liste la cellule est vide)
Réponses
6
Affichages
714
xsara63
X
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…