[ RESOLU Par JOB75 ,Merci ]Calculer le Nb de celulles vertes et faire un classement..

[Guido]

Bonjour le Forum

Je recherche a compter le nombres de cellules verte foncées par lignes

et le nombres de cellules verte foncées par colonne.

et faire afficher un classement par citations.

Voir le petit fichier

Merci

Guido

 

[Mytå]

Il faut copier le code des fonctions personnalisées aussi

 

[Guido]

Il faut copier le code des fonctions personnalisées aussi

Ca je ne sais pas faire ,ni quoi,ni ou, ni comment..

Re Salut Myta

OK, mais ca je ne sais pas faire .DSL

Amitiés

Guido

 

[Mytå]

Re

Ouvre VBA (Alt + F11) et copie le code suivant dans un module

Option Explicit

Function Couleur(r As Range)
For Each r In r
  If r.Interior.ColorIndex = 10 Then Couleur = Couleur + 1 '10 = vert foncé
Next
End Function

Function TriVerticalCouleur(r As Range)
Application.Volatile
If Application.Caller.Parent.Name = ActiveSheet.Name Then
  Dim nlig, ncol, a(), b(), c(), i
  nlig = r.Rows.Count
  ncol = r.Columns.Count - 2
  ReDim a(1 To nlig)
  ReDim b(1 To nlig)
  ReDim c(1 To nlig)
  For i = 1 To nlig
    a(i) = r(i, 1)
    If a(i) Then b(i) = Couleur(r(i, 3).Resize(, ncol)) 'le test fait gagner du temps
    c(i) = b(i) - i / 10000 'pour ne pas modifier l'ordre des ex aequo
  Next
  tri c, a, b, 1, nlig
  ReDim c(1 To nlig, 1 To 2)
  For i = 1 To nlig
    c(i, 1) = IIf(a(i), a(i), "")
    c(i, 2) = IIf(a(i), b(i), "")
  Next
  TriVerticalCouleur = c 'matrice
Else
  TriVerticalCouleur = Application.Caller 'référence circulaire => calcul itérarif
End If
End Function

Function TriHorizontalCouleur(r As Range)
Application.Volatile
If Application.Caller.Parent.Name = ActiveSheet.Name Then
  Dim nlig, ncol, a(), b(), c(), i
  nlig = r.Rows.Count - 1
  ncol = r.Columns.Count
  ReDim a(1 To ncol)
  ReDim b(1 To ncol)
  ReDim c(1 To ncol)
  For i = 1 To ncol
    a(i) = r(1, i)
    b(i) = Couleur(r(2, i).Resize(nlig))
    c(i) = b(i) - i / 10000 'pour ne pas modifier l'ordre des ex aequo
  Next
  tri c, a, b, 1, ncol
  ReDim c(1 To 2, 1 To ncol)
  For i = 1 To ncol
    c(1, i) = a(i)
    c(2, i) = b(i)
  Next
  TriHorizontalCouleur = c 'matrice
Else
  TriHorizontalCouleur = Application.Caller 'référence circulaire => calcul itérarif
End If
End Function

Sub tri(c, a, b, gauc, droi)  ' Quick sort
Dim ref, g, d, temp
ref = c((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While c(g) > ref: g = g + 1: Loop
    Do While ref > c(d): d = d - 1: Loop
    If g <= d Then
      temp = c(g): c(g) = c(d): c(d) = temp
      temp = a(g): a(g) = a(d): a(d) = temp
      temp = b(g): b(g) = b(d): b(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(c, a, b, g, droi)
If gauc < d Then Call tri(c, a, b, gauc, d)
End Sub

Mytå

 

[Guido]

Re

Ouvre VBA (Alt + F11) et copie le code suivant dans un module

Code (Visual Basic):

Re J'ai crée une nv Macros Macro1,dans cette nvM Jai coller le texte et erreur donc suis bloqué..

Guido

 

[Guido]

Re

Bonsoir le Forum

J'ai encore essayé ,mais sans succès.

Donc je fais du sur place a un mètre du poteau...???

Merci d'avance

Guido

 

[job75]

Bonsoir Guido,

Vous êtes vraiment gonflé.

Le fichier du post #45 est une vraie usine à gaz, une poule n'y retrouverait pas ses poussins.

Et comme l'a dit Mytå je n'y vois aucun des codes que je vous ai donnés dans le passé.

A quoi ça sert donc de vous aider ?

Maintenant si vous voulez utiliser mes dernières fonctions n'oubliez pas que le calcul itératif doit être activé.

A+

 

[Guido]

Bonsoir Guido,

Vous êtes vraiment gonflé.

Le fichier du post #45 est une vraie usine à gaz, une poule n'y retrouverait pas ses poussins.

Et comme l'a dit Mytå je n'y vois aucun des codes que je vous ai donnés dans le passé.

A quoi ça sert donc de vous aider ?

Maintenant si vous voulez utiliser mes dernières fonctions n'oubliez pas que le calcul itératif doit être activé.

A+

Re

Bien sur que depuis quelques mois le fichiers et les données ont bien évoluées..

Vos fichiers ont bien servit et sont des Protos,,en stand bay ...

Le fichier que je poste depuis le début du sujet a évolués et arrives a sont terme..

l'arrivées est proche.

Mon soucis comme vous pouvez le constatés en regardant le fichiers et dans les onglet feuil1..2..3..4..5..6..7..les formules

sont la. Mais pas les codes ,je n'ai pas réussit la manœuvre, comme dit plus haut.

Donc je fait appelle aux personnes Job75 ou Myta pour voir si une solution est possible.

Merci d'avance

Amitiés

Guido

 

[JBARBE]

Bonjour Guido, Bonjour à tous,
Hier ( Mercredi 28/12/2016), je décide de faire un spot mixe ( 2 chevaux de mon choix et les 3 derniers par l'ordi du PMU) dans le quinté ( 2 € ) !
J'ai donc joué 11 - 4 et l'ordi du PMU à la suite 12 - 13 - 9 !!!
Quelle fut pas ma surprise d'avoir obtenu le quinté dans l'ordre soit 9070 € pour 2 € !
Certes, ce n'est pas la fortune, mais si j'avais tenu compte des stats de mes 46 pronostiqueurs de mon programme, seul Equidia et Turf Magazine l'ont eu dans le désordre (195,30 € gagnés pour 112 € joués )
A quoi ça sert que Ducro se décarcasse !
De bonne fête pour moi à venir !
Bonne fête à tous et bonne journée !

 

[job75]

Bonjour Guido, le forum,

En plus vous ne suivez pas la discussion.

Il ne faut pas oublier de compléter la Workbook_Open comme indiqué au post #41.

Votre fichier en retour, j'ai mis les fonctions dans le module"Fonctions" comme il se doit.

Bonne journée.

 

[Guido]

Re

Bonjour le Forum

et Bonjour Job75

Je te remercie pour la finalisation du fichier, qui vas me servir pour l'année 2017 et plus.

Merci pour ta patience envers Moi

Si tu a un bout de VBA pour remplacer les données de la veille et transférer les données du jour de TRIO R1..2..3..4..5..6..7..dans les feuils 1..2..3..4..5..6.ou 7

Merci d'avance je mettrais le bouton de la future <macro en page Menu

Merci

Amitiés

Guido

 

[job75]

Re,

Le bout de VBA :

Sub Transfert()
Dim F As Object, i As Byte
Set F = ActiveSheet
Application.ScreenUpdating = False
For i = 1 To 7 'modifier 7 si nécessaire
  With Sheets("Feuil" & i) 'nom des feuilles à adapter
    .Activate
    Sheets("Trio R" & i).[A:X].Copy .[A1]
    .Calculate
  End With
Next
F.Activate
End Sub

A+

 

[job75]

Re,

Pour les passionnés qui suivent vraiment ce fil.

Dans le fichier du post #54 il y a 23 feuilles qui contiennent des formules volatiles.

A l'ouverture, avec la Workbook_Open, les 23 feuilles sont bien sûr recalculées.

Et avec la macro Tranfert précédente il y a 23 x 7 + 7 = 168 feuilles recalculées.

On peut donc gagner du temps avec cette dernière macro en utilisant ce code :

Sub Transfert()
Dim F As Object, i As Byte
Set F = ActiveSheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 1 To 7 'modifier 7 si nécessaire
  With Sheets("Feuil" & i) 'nom des feuilles à adapter
    .Activate
    Sheets("Trio R" & i).[A:X].Copy .[A1] 'pas de recalcul
    .Calculate 'au total 7 feuilles sont recalculées
  End With
Next
F.Activate
Application.Calculation = xlCalculationAutomatic '23 feuilles sont recalculées
End Sub

Les Application.Calculation évitent les recalculs dus aux .Copy, il n'y a plus que 7 + 23 = 30 feuilles recalculées.

C'est vraiment pour pinailler car cela n'a guère d'importance.

En effet la macro du post #56 s'exécute en 0,77 seconde, celle-ci en 0,54 seconde.

Bonne fin de soirée.

 

[Guido]

Bonjour le Forum

Bonjour Myta

Bonjour Job75

Job75 je te remercie pour la finalisation du dernier FICHIER Que j'ai Renommer

PRONOS_V32_AVEC BINGO_DU JOUR_FINAL_2017

Il fonctionne comme une centrale Electrique..YESSSSS

J'ai 2_3 finalités a valider, la ca devrait le faire .

MERCI pour TOUT

Bonne année 2017

Guido

 

[Guido]

Bonjour a Toutes et Tous

Avant de clore ce post, et avoir essayé une dernière sélection, que je ne suis pas arrivés a résoudre

je lance un appel pour finalisés cette requête.

J'aimerais que dans les onglet " Feuil.1 2 3 4 5 6 7 "

Avoir un classement final avec les doublons des deux classement , avec le nombre des citations des couleur horizontal.

Merci d'avance.

Un texte en VBA me suffiras afin d'établir une macros pour toutes les feuilles possibles et courses possibles

j'ajouterais dans la page Menu le Bouton

Merci d'avance

Bonne Année 2017

Amitiés

Guido

 

[Guido]

Re

Je clos se post ayant le résultats désiré avec les couleurs vertes.

Pour le classement des doublons, je posterais une nouvelles demande.

Merci

Guido