[ 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

 

[Guido]

Salut le Forum

Je peux en faire un tableau moi aussi et je serais le premier »

Mytå

Re

Tu doute de Moi et de la véracité du tableau ????

Tu me connais très bien..Guido

Amitiés

Guido

 

[JBARBE]

Bonjour à tous,
Pour le fun, ci-joint les gagnants en 4 (premiers des 8 proposés par les pronostiqueurs ) et en 3 ( 3 premiers sur 8 )

Il y a quand même un peu de positif !
Mais ils sont rare notamment (31,46€ pour Chevaux (valeur) en 4 ( 1€,30 le quarté et 1€ le tiercé )
Pas de quoi être riche !
bonne journée !

 

[Guido]

Re

Salut JBARBE

Merci pour les stats.

Mais personne n'a une réponse a ma ou mes demandes..,.

a plus

Guido

 

[JBARBE]

Re

Salut JBARBE

Merci pour les stats.

Mais personne n'a une réponse a ma ou mes demandes..,.

a plus

Guido

Re,
Désolé Guido, c'est hors de mes compétences !
Bonne journée !

 

[job75]

Bonjour Guido, Lone-wolf, JBARBE,

D'après ce que je comprends ce n'est guère compliqué.

Voyez le fichier joint et ce code :

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

Sub Tri_Corde()
Dim c As Range
Application.ScreenUpdating = False
On Error Resume Next 'si la colonne B est vide
For Each c In [B:B].SpecialCells(xlCellTypeConstants, 2)
  If c Like "Rang*" Then
    c(1, 2).Resize(13, 9).Sort c(13, 2), xlDescending, Orientation:=xlLeftToRight
    Calculate
  End If
Next
End Sub

Sub Tri_Rang()
Dim c As Range
Application.ScreenUpdating = False
On Error Resume Next 'si la colonne B est vide
For Each c In [B:B].SpecialCells(xlCellTypeConstants, 2)
  If c Like "Rang*" Then
    c(1, 2).Resize(13, 9).Sort c(1, 2), xlAscending, Orientation:=xlLeftToRight
    Calculate
  End If
Next
End Sub

La comptabilisation des couleurs se fait sur la ligne "Corde" (qui n'était pas utilisée).

A+

 

[Guido]

Bonjour Le Forum et Job75

Merci pour la 2eme partie des tableaux, je te renvoie le fichier avec ma 1ere demande

Les emplacement seront tjrs au même endroit des max 7 réunions et de max 9 courses.neufs courses

le fichiers comprendras 7 feuilles identique ,avec 2 boutons par pages c'est bien ca...???

mais avec le nom de l'onglet qui change dans le VBA...???

a plus

Merci d'avance

Guido

 

[job75]

Re,

Sachez une chose Guido : je ne veux plus faire avec vous des discussions qui n'en finissent pas.

Car vos desiderata changent sans arrêt et vous ne savez pas y mettre un terme.

[Edit] De plus comme vous ne faites jamais de commentaire on ne sait même pas si vous avez compris ce qui est proposé.

Pour finir voici une solution plus élaborée et surtout plus rapide avec les Application.Calculation :

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

Sub Tri_Corde()
Tri 13, xlDescending
End Sub

Sub Tri_Rang()
Tri 1, xlAscending
End Sub

Sub Tri(lig As Byte, sens)
Dim c As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next 'si la colonne B est vide
For Each c In [B:B].SpecialCells(xlCellTypeConstants, 2)
  If c Like "Rang*" Then _
    c(1, 2).Resize(13, 9).Sort c(lig, 2), sens, Orientation:=xlLeftToRight
Next
Application.Calculation = xlCalculationAutomatic
End Sub

Fichier (2).

Si vous voulez autre chose débrouillez-vous pour l'adapter.

Bonne continuation.

 

[job75]

Re,

Je vous mets quand même le code adapté pour traiter plusieurs feuilles (c'est assez évident) :

Sub Tri(lig As Byte, sens)
Dim w As Worksheet, c As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each w In Worksheets
  If Application.CountIf(w.[B:B], "Rang*") Then
    For Each c In w.[B:B].SpecialCells(xlCellTypeConstants, 2)
      If c Like "Rang*" Then _
        c(1, 2).Resize(13, 9).Sort c(lig, 2), sens, Orientation:=xlLeftToRight
    Next c
  End If
Next w
Application.Calculation = xlCalculationAutomatic
End Sub

Fichier (3).

Chez moi (Win 10 - Excel 2013) les 63 tris se font en 0,11 seconde.

 

[JBARBE]

Re

Tu aurais du préciser que je t'ai donné un début de solution sur un autre Forum.

Mytå

Bonsoir à tous,
Excuse-moi de t'avoir oublié dans mon projet compte tenu que celui-ci a nécessité plusieurs personnes dont je ne me souviens plus les noms !
Merci à toi et aux autres !
De temps en temps j’essaie d’apporter une amélioration au fichier afin d'obtenir un maximum d’éléments pour faciliter les gains au PMU ( pas facile de gagner comme je l'ai expliqué précédemment ) et surtout pour utiliser toutes les possibilités d'Excel !
Je tiens à préciser que je possède plusieurs fichiers Excel de ma seule conception qui me facilite la vie :
Fichiers de :
- consommation eau
- consommation électrique
- pense bête
- Compte bancaire
- Foot ligue 1
- dépense PMU
- course à pied
- vélo
Etc.....

Certes, ma connaissance d'Excel n'est pas exceptionnelle, mais je peux saluer ce site et ces bénévoles qui m'ont permis de progresser !
Ainsi, je demanderais à Guido d'essayer de comprendre l'aide qu'on lui apporte dans ses fichiers et même demander des explications !
Certes, ce n'est pas toujours facile mais comme l'on dit " c'est en forgeant qu'on devient forgeron "

Bonne soirée !

 

[JBARBE]

Re le Forum

JBARBE, désolé le message était addressé à Guido

Mytå

Re,
Ne t'excuse pas, j'ai ma part de sollicitation envers les bénévoles qui était le bienvenu dans ce forum !
Peut-être que tu en a fait parti également !
Quoi qu'il en soit, Guido m'avait sollicité en message privé pour lui enseigner le VBA il y a quelques temps !
J'ai eu tort de ne pas y répondre, néanmoins il y a beaucoup d'exemples d'enseignement sur le Web ( il suffit de faire des recherches et surtout d'être motivé ) !
C'est comme cela que je me suis formé ainsi qu'avec de vieux bouquins VBA dépassés !
Peut-être qu'un jour Guido pourra a son tour rendre service sur excel-downloads ! Qui sait !
Bonne soirée !

 

[Guido]

Re le Forum

JBARBE, désolé le message était addressé à Guido

Re

Job75 ecrit:

Sachez une chose Guido : je ne veux plus faire avec vous des discussions qui n'en finissent pas.

Car vos desiderata changent sans arrêt et vous ne savez pas y mettre un terme.

[Edit] De plus comme vous ne faites jamais de commentaire on ne sait même pas si vous avez compris ce qui est proposé.


Salut Job75

Chaque fois que tu as terminé un fichier ,j'ai toujours dit Merci.

Je suis revenu vers 14.15 pour faire une demande, afin de terminé la deuxième partie du fichier.

Bonjour Le Forum et Job75

Merci pour la 2eme partie des tableaux, je te renvoie le fichier avec ma 1ere demande

Les emplacement seront tjrs au même endroit, de max 7 réunions et de max 9 courses,

avec 2 boutons en pages accueil et 2 boutons dans tableaux accueil ou deux pour les 14 onglets..??

voici le fichier final

a plus

Merci d'avance

Amitiés

Guido

 

[JBARBE]

Re,
Je me permet d'apporter toute mon admiration à Job75 non seulement pour ses exceptionnelles macros mais aussi pour son incroyable patience avec toi Guido !
Depuis toujours et lorsque tu mettais un post sur ce forum Job 75 t'as toujours aidé !
On ne te reproche pas Guido ta politesse et ta gentillesse mais bon sang fait un effort pour d'exprimer convenablement afin que l'on puissent te rendre service !
Quand à ce fichier de stats présenté, parole de turfiste, je n'ai rien compris !
Bonne nuit à tous !

 

[Guido]

Re

JBARBE dit

Quoi qu'il en soit, Guido m'avait sollicité en message privé pour lui enseigner le VBA il y a quelques temps !
J'ai eu tort de ne pas y répondre, néanmoins il y a beaucoup d'exemples d'enseignement sur le Web ( il suffit de faire des recherches et surtout d'être motivé ) !
C'est comme cela que je me suis formé ainsi qu'avec de vieux bouquins VBA dépassés !

Peut-être qu'un jour Guido pourra a son tour rendre service sur excel-downloads ! Qui sait !

Re

J'ai déjà appris certaines choses ici et je les appliques quand j'y parvient.

Mais je ne sais que 0.1 pour mille en VBA..

Merci.

Re

Myta

Bien sur tu ma donner une très bonne partie de mes demandes.et a chaque fois, je t'ai écrit un petit mot sympa.

Amitiés sincères a Tous et Toutes

Guido

 

[Guido]

Re

Nos messages se sont croisés

Je peut le confirmé,

Job75 est une PERSONNE que je respecte, et que j'Admires pour sa Patience, et je lui en ais fait part dans mes réponses.

Ont ma même reprochés de trop le cité..et qu'il n'y avait pas que Job75 qui participais sur le Forum.

Voila tout est dis Amitiés

Guido

 

[job75]

Bonjour Guido, le forum,

Si vous voulez le résultat du classement dans des tableaux (comme AB27:AJ28) voici une solution par fonction VBA matricielle.

Le tri est réalisé par la macro Quick sort :

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 TriCouleur(r As Range)
Application.Volatile
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
TriCouleur = c 'matrice
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

Fichier joint.

Le recalcul des formules (volatiles) des 63 tableaux se fait en 0,10 seconde.

A+