XL 2019 Insérer une formule Excel via VBA avec boucle.

gilboss · 2 Octobre 2022

Bonjour,
J'aimerai insérer une formule Excel via un code VBA sur 31 colonnes avec changement de lettre par formule.
Cette formule est à écrire dans les cellules C30 à AG30 avec l'incrément des lettres C dans la formule (C à AG)
=SOMME_SI_COULEUR(C$31:C$34;16777215) jusqu'à =SOMME_SI_COULEUR(AG$31:AG$34;16777215)

Je n'y parviens pas. (Je suis novice)
Si quelqu'un pouvait m'aider, je le remercie d'avance
Je pourrais écrire la formule directement dans les cellules, mais ce n'est pas mon souhait.

Staple1600 · 2 Octobre 2022

Bonjour @gilboss, le fil

On peut voir à quoi ressemble ta fonction VBA personnalisée : SOMME_SI_COULEURS ?

gilboss · 2 Octobre 2022

Staple1600 à dit:
Bonjour @gilboss, le fil

On peut voir à quoi ressemble ta fonction VBA personnalisée : SOMME_SI_COULEURS ?

J'ai installé le Pack de fonction XLP qui permet de faire fonctionner ce code qui n'est pas VBA mais excel.
Cela additionne uniquement les cellules Blanches.
J'ai trouvé ce pack sur ce site. il marche très bien. https://www.excel-pratique.com/fr/fonctions-complementaires

Phil69970 · 2 Octobre 2022

Bonjour @gilboss
Edit : Bonjour Staple
Et comme le dit Staple c'est indépendamment de la justesse de ta formule

Je te propose

Tu copie ta formule en C30 et tu lances la macro

VB:

Sub Recopie()
Range("C30").AutoFill Destination:=Range("C30:AG30"), Type:=xlFillDefault
End Sub

Merci de ton retour

@Phil69970

gilboss · 2 Octobre 2022

Phil69970 à dit:
Bonjour @gilboss

Je te propose

Tu copie ta formule en C30 et tu lances la macro

VB:

Sub Recopie() Range("C30").AutoFill Destination:=Range("C30:AG30"), Type:=xlFillDefault End Sub

Merci de ton retour

@Phil69970

Merci Phil66970
Cette formule implique d'écrire ma formule directement dans une cellule. ça je le fais déja en faisant copier glissé sans passer par le VBA.
Mais je m'explique: Cette formule ne fait pas partie intégrante de Excel pour le moment. C'est pour cela qu'il faut installer ce pack de fonction XLP. Tant que ça reste dans mon PC, ça va. Mais j'ai installé mon fichier Excel dans un autre PC sans avoir au préalable installé le pack de fonction XLP.
Du coup, les formules sommes_si_couleur ont été remplacés par un 0
Il a fallu toutes les réécrire après avoir installé le pack de fonction XLP.
Donc je me dis, pourquoi pas écrire cette formule via VBA qui ne se perdra pas. Bien sûr, je sais que cela ne marchera pas si le pack de fonction VBA n'est pas installé. Mais ça peut calmer les nerfs.

gilboss · 2 Octobre 2022

Phil69970 à dit:
Bonjour @gilboss
Edit : Bonjour Staple
Et comme le dit Staple c'est indépendamment de la justesse de ta formule

Je te propose

Tu copie ta formule en C30 et tu lances la macro

VB:

Sub Recopie() Range("C30").AutoFill Destination:=Range("C30:AG30"), Type:=xlFillDefault End Sub

Merci de ton retour

@Phil69970

Merci Phil69970
Ta formule implique d'écrire directement dans Excel ma formule Somme_si_couleur.
Je l'ai déjà fait en faisant copier glissé sans passer par le vba.
Je m'explique: somme_si_couleur n'est pas, pour le moment une formule Excel. Il faut installer ce pack de fonction XLP. Tant que c'est dans mon pc, tout va bien. Mais j'ai déplacé mon fichier dans un autre PC sans au préalable installé ce pack. Mes formules somme_si_couleur ont été remplacées par un 0. Il a fallu toute les réécrire après avoir installé ce pack. Le nerfs à bouts, je me suis dis pourquoi pas écrire ma formule somme_si_couleur en VBA. au moins là elle ne se perdra pas. Je sais bien que si le pack n'est pas installé, cela ne fonctionnera pas. mais au moins cela évitera des réécritures inutile après installation du pack de fonction XLP.

Phil69970 · 2 Octobre 2022

Re

Le problème avec des packs genre xlp et d'autres c'est qu'il est sur ton PC mais pas sur les autres PC comme tu le dit si bien.

Perso je ne compte pas l'installer pour m’éviter ces problèmes de compatibilité lors de portage de fichiers sur d'autres PC.

Trouvé sur le net les 2 mêmes fonctions suivant ce que tu veux faire (Idem couleur de fond ou idem couleur du texte) et qui fonctionnent.

https://forum.pcastuces.com/somme_si_couleur_-f23s36757.htm

@Phil69970

gilboss · 2 Octobre 2022

Phil69970 à dit:
Re

Le problème avec des packs genre xlp et d'autres c'est qu'il est sur ton PC mais pas sur les autres PC comme tu le dit si bien.

Perso je ne compte pas l'installer pour m’éviter ces problèmes de compatibilité lors de portage de fichiers sur d'autres PC.

Trouvé sur le net les 2 mêmes fonctions suivant ce que tu veux faire (Idem couleur de fond ou idem couleur du texte) et qui fonctionnent.

https://forum.pcastuces.com/somme_si_couleur_-f23s36757.htm

@Phil69970

Merci Phil, je vais regarder cela à tête reposé.

Staple1600 · 2 Octobre 2022

Re

Pour info
Le pack complémentaire ( ce qu'on appelle un addin) est réalisé en VBA
Donc c'est du VBA, mais c'est ici accessoire.

Et pas besoin de pack supplémentaire.
Il suffit de mettre ceci dans ton classeur de macros complémentaires.
(NB: C'est un exemple simple, il y a en plein d'autres sur le forum -> dans les archives)

VB:

Function SOMMECOULEURS(PLAGE As Range, Couleur As Integer) As Double
Dim c
For Each c In PLAGE
If (c.Interior.ColorIndex = Couleur) Then
SOMMECOULEURS = SOMMECOULEURS + c.Value
End If
Next c
End Function

gilboss · 2 Octobre 2022

Staple1600 à dit:
Re

Pour info
Le pack complémentaire ( ce qu'on appelle un addin) est réalisé en VBA
Donc c'est du VBA, mais c'est ici accessoire.

Et pas besoin de pack supplémentaire.
Il suffit de mettre ceci dans ton classeur de macros complémentaires.
(NB: C'est un exemple simple, il y a en plein d'autres sur le forum -> dans les archives)

VB:

Function SOMMECOULEURS(PLAGE As Range, Couleur As Integer) As Double Dim c For Each c In PLAGE If (c.Interior.ColorIndex = Couleur) Then SOMMECOULEURS = SOMMECOULEURS + c.Value End If Next c End Function

Merci, j'ai essayé ce code, il marche mais pas sur les cellules au couleurs en mise en forme conditionnelles. il estime la couleur d'origine mais pas la conditionnelle.

Staple1600 · 2 Octobre 2022

Re

Ce n'est pas un problème il suffisait de le dire
Le code nécessite juste une petite adaptation.
(que je posterai dès que rédigée et testée)

Staple1600 · 2 Octobre 2022

Re

C'est plutôt une francisation qu'une rédaction
Test OK
Pour tester, il faut avoir une cellule colorée référence (ici A1)
En B3:10 plage de cellule avec MFC
=SOMMECOULEURS(B3:B10;A1)
J'obtiens bien la somme des cellules MCF qui ont la même couleur qu'en A1

VB:

Function SOMMECOULEURS(PLAGE As Range, Couleur As Range) As Double
Dim COUL As Long
Dim c As Range
Dim colsum As Double
COUL = Couleur.Interior.ColorIndex
For Each c In PLAGE
If PLAGE.Parent.Evaluate("DColorIndex(" & c.Address & ")") = COUL Then
colsum = colsum + c.Value
End If
Next c
SOMMECOULEURS = colsum
End Function
Private Function DColorIndex(r As Range) As Long
DColorIndex = r.DisplayFormat.Interior.ColorIndex
End Function

Crédits: Hans Vogelaar (MVP)

gilboss · 3 Octobre 2022

Staple1600 à dit:
Re

C'est plutôt une francisation qu'une rédaction
Test OK
Pour tester, il faut avoir une cellule colorée référence (ici A1)
En B3:10 plage de cellule avec MFC
=SOMMECOULEURS(B3:B10;A1)
J'obtiens bien la somme des cellules MCF qui ont la même couleur qu'en A1

VB:

Function SOMMECOULEURS(PLAGE As Range, Couleur As Range) As Double Dim COUL As Long Dim c As Range Dim colsum As Double COUL = Couleur.Interior.ColorIndex For Each c In PLAGE If PLAGE.Parent.Evaluate("DColorIndex(" & c.Address & ")") = COUL Then colsum = colsum + c.Value End If Next c SOMMECOULEURS = colsum End Function Private Function DColorIndex(r As Range) As Long DColorIndex = r.DisplayFormat.Interior.ColorIndex End Function

Crédits: Hans Vogelaar (MVP)

Merci beaucoup Staple, Malheureusement elle ne marche pas chez moi. J'ai retirer mon pack de fonction pour éviter un eventuelle bug. J'ai placé dans un module le fonction, dans le code de la page le private fonction et j'ai mis dans cette page la cellule A1 en couleur jaune et la plage de B3:B10 en MCF couleur jaune si compris en 1 et 15.
résultat #valeur. J'ai dû louper un truc

gilboss · 3 Octobre 2022

gilboss à dit:
Merci beaucoup Staple, Malheureusement elle ne marche pas chez moi. J'ai retirer mon pack de fonction pour éviter un eventuelle bug. J'ai placé dans un module le fonction, dans le code de la page le private fonction et j'ai mis dans cette page la cellule A1 en couleur jaune et la plage de B3:B10 en MCF couleur jaune si compris en 1 et 15.
résultat #valeur. J'ai dû louper un truc

Je précise, j'ai Excel 2021

Staple1600 · 3 Octobre 2022

Bonsoir le fil

@gilboss
Dans un classeur où tu auras copié les deux fonctions que j'ai postées.
(message#12)
Copie puis éxécute cette macro qui créé un exemple

Code:

Sub Macro_pour_créer_exemple()
Dim t
t = Array(2, 3, 7, 6, vbNullString, vbNullString, 1, 0, vbNullString, 8)
Range("A1").Interior.ColorIndex = 6
Range("B3:B10").Value = Application.Transpose(t)
Range("B3:B10").FormatConditions.Add Type:=xlExpression, Formula1:="=ET(EST.PAIR($B3);$B3>0)"
Range("B3:B10").FormatConditions(Range("B3:B10").FormatConditions.Count).SetFirstPriority
Range("B3:B10").FormatConditions(1).Interior.ColorIndex = 6
Range("B12").Formula = "=SOMMECOULEURS(B3:B10,A1)"
Range("B12").Font.Bold = -1
End Sub

La somme en B12 est correcte, non ?

Pour continuer le test, change manuellement quelles valeurs
(en mettant deux, trois ou quatre chiffres pairs)
Tu verrais que la somme s'actualisera et sera bonne.

XL 2019 Insérer une formule Excel via VBA avec boucle.

gilboss

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

gilboss

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

gilboss

XLDnaute Nouveau

gilboss

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

gilboss

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

gilboss

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

gilboss

XLDnaute Nouveau

gilboss

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Discussions similaires