Fonction_Underline_&_Colorindex

[coline741]

Bonjour aux Passionnés !

J'aimerais savoir pourquoi ces deux fonctions présentent des anomalies [résultats incohérents; ou # VALEUR!]

Elles doivent être compatibles avec SOMMEPROD

Function souligneTxt(champ As Range)
For Each cell In champ
If cell.Font.Underline = xlUnderlineStyleSingle Then vSomme = vSomme + cell.Value
Next
souligneTxt = vSomme
End Function

…celle-ci est pire encore

Function soulrgTxt(champ As Range)
Application.Volatile
Dim temp()
ReDim temp(1 To champ.Count)
For i = 1 To champ.Count
temp(i) = champ(i).Font.Underline.ColorIndex
Next i
soulrgTxt = Application.Transpose(temp)
End Function

D'avance merci !

 

[Paf]

Re : Fonction_Underline_&_Colorindex

Bonjour

en I4, modifier =SOMMEPROD((phase=G4)*(souligneTxt(nombre))) en

=SOMMEPROD((phase=G4)*(souligneTxt(nombre))*nombre)

et modifier la Function SouligneTxt(champ As Range) comme ceci

Function SouligneTxt(champ As Range)
 Dim temp()
 ReDim temp(champ.Count - 1)
 For Each cell In champ
    temp(i) = cell.Font.Underline = xlUnderlineStyleSingle
    i = i + 1
 Next
 SouligneTxt = Application.Transpose(temp)
End Function

A+

 

[coline741]

Re : Fonction_Underline_&_Colorindex

Yes, Mister Paf

Merci pour la première réponse…elle fonctionne parfaitement avec SOMMEPROD pour les occurences soulignées…utilisée seule le résultat est

=souligneTxt(nombre) donne FAUX…c'est dingue non !

Dans le cas où je veux associer cell.Font.Underline = xlUnderlineStyleSingle avec Cell.Font.ColorIndex=3 ou 5 pour sommer les cellules avec format souligné rouge ou bleu - et pas les autres - temp(i) m'a refusé toutes les associations comme "+" , "and " …

J'ai modifié la seconde fonction de l'envoi sur la base de la fonction "souligneTxt" sans résultat…toujours problème de # valeur !

Je suis sûr que Paf va trouver le gadget pour mon étude de 4000 lignes, 20 colonnes, et de 8 phases

A+ et cordial salut Man

 

[Paf]

Re : Fonction_Underline_&_Colorindex

Re,

utilisée seule le résultat est
=souligneTxt(nombre) donne FAUX…c'est dingue non !

en fait la fonction génère un tableau rempli de VRAI ou FAUX qui permet à SommeProd de savoir ce qui doit être pris en compte

Dans le cas où je veux associer cell.Font.Underline = xlUnderlineStyleSingle avec Cell.Font.ColorIndex=3 ou 5 pour sommer les cellules avec format souligné rouge ou bleu

Solution possible:

la formule devient =SOMMEPROD((phase=G4)*(couleurTxt(nombre))*(souligneTxt(nombre))*nombre)
avec la fonction couleurtxt modifiée:

Function couleurTxt(champ As Range)
  Application.Volatile
  Dim temp()
  ReDim temp(champ.Count - 1)
  For Each cell In champ
   temp(i) = (cell.Font.ColorIndex = 3 Or cell.Font.ColorIndex = 5)
   i = i + 1
  Next
  couleurTxt = Application.Transpose(temp)
End Function

ou bien en fusionnant les deux fonctions:

=SOMMEPROD((phase=G4)*(SoulCoul(nombre))*nombre)

Function SoulCoul(champ As Range)
 Dim temp()
 ReDim temp(champ.Count - 1)
 For Each cell In champ
    temp(i) = (cell.Font.ColorIndex = 3 Or cell.Font.ColorIndex = 5) And cell.Font.Underline = xlUnderlineStyleSingle
    i = i + 1
 Next
 SoulCoul = Application.Transpose(temp)
End Function

A+

 

[coline741]

Re : Fonction_Underline_&_Colorindex

Merci à Toi Paf pour toutes tes explications, notamment pour la fonction Soulcoul tant attendue. Elle fonctionne à merveille.

Chantre de l'application volatile, héraut de la fonction qui sauve, je te salue amicalement bien bas

Bonne semaine à toi

 

[Paf]

Re : Fonction_Underline_&_Colorindex

Re,

une dernière version plus dans l'esprit de ce qui existait:

=SOMMEPROD((phase=G4)*((couleurTxt(nombre)=5)+(couleurTxt(nombre)=3))*(souligneTxt(nombre)=2)*nombre)

Function souligneTxt(champ As Range)
  Application.Volatile
  Dim temp()
  ReDim temp(1 To champ.Count)
  For i = 1 To champ.Count
   temp(i) = champ(i).Font.Underline
  Next i
  souligneTxt = Application.Transpose(temp)
End Function

Function couleurTxt(champ As Range)
  Application.Volatile
  Dim temp()
  ReDim temp(1 To champ.Count)
  For i = 1 To champ.Count
   temp(i) = champ(i).Font.ColorIndex
  Next i
  couleurTxt = Application.Transpose(temp)
End Function

A+