Macro Excel/VBA
Résolu
jpleroisse
Messages postés
1788
Date d'inscription
mardi 7 novembre 2000
Statut
Membre
Dernière intervention
11 mars 2006
-
7 avril 2005 à 18:55
cs_AbriBus Messages postés 492 Date d'inscription jeudi 28 août 2003 Statut Membre Dernière intervention 25 avril 2007 - 14 avril 2005 à 05:16
cs_AbriBus Messages postés 492 Date d'inscription jeudi 28 août 2003 Statut Membre Dernière intervention 25 avril 2007 - 14 avril 2005 à 05:16
11 réponses
cs_AbriBus
Messages postés
492
Date d'inscription
jeudi 28 août 2003
Statut
Membre
Dernière intervention
25 avril 2007
5
11 avril 2005 à 17:50
11 avril 2005 à 17:50
Private Const HeadLigne As Integer = 1 'Nombre de lignes qui NE DOIVENT PAS etre remplies (ici je presume qu'il n'y a qu'une ligne de legende)
Private Const ColClassClub As Integer = 4 ' Numero de la colone adéquate pour classer les clubs
Private Const ColCour As Integer = 1 ' Numero de colone correspondant aux coureurs
Private Const ColClub As Integer = 2 ' Numero de la colone correspondant aux clubs des courreurs.
Private Const ColNbrRep As Integer = 5 ' Numero de la colone qui va afficher le nombre de coureurs dans ce club.
Public Function RangeClub() As Integer ' Déclare une fonction qui va ranger les clubs dans la case appropriée et renvoyer le nombre de club représentés
Dim NbrLigne as Integer ' Déclare un entier qui servira de compteur et de référence a l'ajout de club
Dim NomClub As String ' Déclare une chaine de caractère qui va permetre de comparer les clubs existants et les clubs inscrits.
Dim ParcourClub as Integer 'Déclare un entier qui permetra le parcour de la liste des clubs deja repertoriés.
Dim DejaVu as Boolean ' Ce booleen va permetre de savoir si le representant d'un club a été ajouté
NbrLigne = HeadLigne ' Positionne le curseur sur la bonne ligne
Do ' Déclare la boucle de parcour des coureurs
NbrLigne = NbrLigne + 1 ' Passe a la ligne suivante
NomClub = Cells(NbrLigne, ColClub) ' Affecte la valeur de la cellule correspondant au club du coureur en cours
ParcourClub = HeadLigne ' Commence le parcourt apres la/les lignes du header
DejaVu = False 'S'assure que DejaVu vaut False
Do ' Boucle imbriquée parcourant l'ensemble des club déjà repertoriés dans le tableaux des clubs
ParcourClub = ParcourClub + 1 'Implemente le numero de la ligne de parcourt des club If(LCase(NomClub) LCase(Cells(ParcourClub, ColClassClub) then Cells(ParcourClub, ColNbrRep) val(Cells(ParcourClub, ColNbrRep)) + 1: DejaVu = True 'Ajoute un representant au club representé et deja répertorié et affete la valeur True au booleen DejaVu. (LCase pour ne pas tenire compte de la case)
Loop Until(Cells(ParcourClub, ColClassClub) = "") 'Fin de la boucle imbriquée avec condition de sortie TantQue dès que la cellule suivante est nulle If(Not(DejaVu)) Then Cells(ParcourClub, ColClassClub).Value NomClub: Cells(ParcourClub, ColNbrRep).Value "1" ' Ajoute le club dans la liste des clubs représenté et y inscrit 1 coureur si la condition DejaVu n'est PAS remplie
Loop Until(Cells(NbrLigne, ColCour) <> "") 'Fin de boucle TantQue avec condition de sortie [contenuCellule = null]
NbrLigne = HeadLigne ' Maintenant qu'on a fini de s'en servir on va recycler l'Integer NbrLigne
Do 'Demarre la boucle de comptage
NbrLigne = NbrLigne + 1 'Incremente l'Integer NbrLigneLoop Until(Cells(NbrLigne, ColClassClub) "" 'Condition de la boucle de sortie de la boucle> ligne suivante de la colone ColClassClub = null
RangeClub = NbrLigne 'Comme le Return de java me manque !!
End Function
Ma parole c'que ca peut etre moche !! (ca serait bien qu'on puisse joindre une source dans les forums).
Bon, j'ai fait un bete copier/coler donc la mise en page devait etre respectée si tu fais pareil. De plus, j'ai pas d'éditeur Vb sous la main, j'ai fait ca avec notepad donc il y aura peut etre deux trois "betises" mais comme j'ai commenté toutes les lignes tu devrais t'en sortir... oublies pas le "Option Explicit" au debut du code...
@+
Private Const ColClassClub As Integer = 4 ' Numero de la colone adéquate pour classer les clubs
Private Const ColCour As Integer = 1 ' Numero de colone correspondant aux coureurs
Private Const ColClub As Integer = 2 ' Numero de la colone correspondant aux clubs des courreurs.
Private Const ColNbrRep As Integer = 5 ' Numero de la colone qui va afficher le nombre de coureurs dans ce club.
Public Function RangeClub() As Integer ' Déclare une fonction qui va ranger les clubs dans la case appropriée et renvoyer le nombre de club représentés
Dim NbrLigne as Integer ' Déclare un entier qui servira de compteur et de référence a l'ajout de club
Dim NomClub As String ' Déclare une chaine de caractère qui va permetre de comparer les clubs existants et les clubs inscrits.
Dim ParcourClub as Integer 'Déclare un entier qui permetra le parcour de la liste des clubs deja repertoriés.
Dim DejaVu as Boolean ' Ce booleen va permetre de savoir si le representant d'un club a été ajouté
NbrLigne = HeadLigne ' Positionne le curseur sur la bonne ligne
Do ' Déclare la boucle de parcour des coureurs
NbrLigne = NbrLigne + 1 ' Passe a la ligne suivante
NomClub = Cells(NbrLigne, ColClub) ' Affecte la valeur de la cellule correspondant au club du coureur en cours
ParcourClub = HeadLigne ' Commence le parcourt apres la/les lignes du header
DejaVu = False 'S'assure que DejaVu vaut False
Do ' Boucle imbriquée parcourant l'ensemble des club déjà repertoriés dans le tableaux des clubs
ParcourClub = ParcourClub + 1 'Implemente le numero de la ligne de parcourt des club If(LCase(NomClub) LCase(Cells(ParcourClub, ColClassClub) then Cells(ParcourClub, ColNbrRep) val(Cells(ParcourClub, ColNbrRep)) + 1: DejaVu = True 'Ajoute un representant au club representé et deja répertorié et affete la valeur True au booleen DejaVu. (LCase pour ne pas tenire compte de la case)
Loop Until(Cells(ParcourClub, ColClassClub) = "") 'Fin de la boucle imbriquée avec condition de sortie TantQue dès que la cellule suivante est nulle If(Not(DejaVu)) Then Cells(ParcourClub, ColClassClub).Value NomClub: Cells(ParcourClub, ColNbrRep).Value "1" ' Ajoute le club dans la liste des clubs représenté et y inscrit 1 coureur si la condition DejaVu n'est PAS remplie
Loop Until(Cells(NbrLigne, ColCour) <> "") 'Fin de boucle TantQue avec condition de sortie [contenuCellule = null]
NbrLigne = HeadLigne ' Maintenant qu'on a fini de s'en servir on va recycler l'Integer NbrLigne
Do 'Demarre la boucle de comptage
NbrLigne = NbrLigne + 1 'Incremente l'Integer NbrLigneLoop Until(Cells(NbrLigne, ColClassClub) "" 'Condition de la boucle de sortie de la boucle> ligne suivante de la colone ColClassClub = null
RangeClub = NbrLigne 'Comme le Return de java me manque !!
End Function
Ma parole c'que ca peut etre moche !! (ca serait bien qu'on puisse joindre une source dans les forums).
Bon, j'ai fait un bete copier/coler donc la mise en page devait etre respectée si tu fais pareil. De plus, j'ai pas d'éditeur Vb sous la main, j'ai fait ca avec notepad donc il y aura peut etre deux trois "betises" mais comme j'ai commenté toutes les lignes tu devrais t'en sortir... oublies pas le "Option Explicit" au debut du code...
@+
cs_AbriBus
Messages postés
492
Date d'inscription
jeudi 28 août 2003
Statut
Membre
Dernière intervention
25 avril 2007
5
8 avril 2005 à 04:43
8 avril 2005 à 04:43
Salut,
ca devrait pas etre tres dur, en VBA ce qui est super important (probablement encore plus qu'en Vb) c'est l'algo. pour ta premiere question, j'ai bien tout de suite une solution simple qui me vient a l'esprit:
lancer une boucle TANTQUE avec en condition de sortie "la cellule ne contient pas texte vide" ce qui en algo se traduit par
Fonction Compteur2Clubs C'EST ENTIER
i C'EST ENTIER
TANTQUE [CellulePasVide] FAIRE
i = i + 1
FinTANTQUE
RETOURNE i
FinFonction
ce qui en Vb donne appliqué a ton cas:
Public Function getNbrClub() as Integer
Dim i as Integer
Do
i = i + 1
Loop While(Cells(i, 2).Value <> "") // on peut aussi utiliser Until(Cells(i, 2).Value = "")
getNbrClub = i
End Function
Nb: L'inconveignant majeure a cette fonction enfantine c'est que ca marche bien tant que tu ne sautes pas de ligne... car bien evidemment, en suivant l'algo tu t'apercois que s'il y a 20 lignes et que la 4eme ne contient pas de texte, la fonction renvera 4
Pour ta deuxieme question... il faudrait que tu precise un peu ce que tu entend par "inscrirent dans d'autres cellules"
Bonne prog...
@briBus
ca devrait pas etre tres dur, en VBA ce qui est super important (probablement encore plus qu'en Vb) c'est l'algo. pour ta premiere question, j'ai bien tout de suite une solution simple qui me vient a l'esprit:
lancer une boucle TANTQUE avec en condition de sortie "la cellule ne contient pas texte vide" ce qui en algo se traduit par
Fonction Compteur2Clubs C'EST ENTIER
i C'EST ENTIER
TANTQUE [CellulePasVide] FAIRE
i = i + 1
FinTANTQUE
RETOURNE i
FinFonction
ce qui en Vb donne appliqué a ton cas:
Public Function getNbrClub() as Integer
Dim i as Integer
Do
i = i + 1
Loop While(Cells(i, 2).Value <> "") // on peut aussi utiliser Until(Cells(i, 2).Value = "")
getNbrClub = i
End Function
Nb: L'inconveignant majeure a cette fonction enfantine c'est que ca marche bien tant que tu ne sautes pas de ligne... car bien evidemment, en suivant l'algo tu t'apercois que s'il y a 20 lignes et que la 4eme ne contient pas de texte, la fonction renvera 4
Pour ta deuxieme question... il faudrait que tu precise un peu ce que tu entend par "inscrirent dans d'autres cellules"
Bonne prog...
@briBus
jpleroisse
Messages postés
1788
Date d'inscription
mardi 7 novembre 2000
Statut
Membre
Dernière intervention
11 mars 2006
27
8 avril 2005 à 15:19
8 avril 2005 à 15:19
J'entends par inscrire dans d'autres cellules, le fait que l'organisateur de la course me demande d'imprimer en plus du classement une feuille avec le nombres de clubs représentés.
Dons dans ma liste d'inscriptions, j'ai 100 coureurs dont plusieurs font parties du même club, ce club ne doit donc apparaître q'une fois sur ma 2ème feuille, par exemple comme ci dessus, dans la cellule D1 et en E1 le nombre de représentans de ce club.
Voilà j'espère que ces explications sont assez claires, j'ai essayé de faire un copier coller de ma feuille pour la placer sur cette page, mais je n'y arrive pas.
D'avance Merci
jpleroisse
Dons dans ma liste d'inscriptions, j'ai 100 coureurs dont plusieurs font parties du même club, ce club ne doit donc apparaître q'une fois sur ma 2ème feuille, par exemple comme ci dessus, dans la cellule D1 et en E1 le nombre de représentans de ce club.
Voilà j'espère que ces explications sont assez claires, j'ai essayé de faire un copier coller de ma feuille pour la placer sur cette page, mais je n'y arrive pas.
D'avance Merci
jpleroisse
cs_nico39
Messages postés
56
Date d'inscription
vendredi 4 mars 2005
Statut
Membre
Dernière intervention
4 octobre 2006
11 avril 2005 à 12:21
11 avril 2005 à 12:21
Salut jpleroisse,
ce n'est qu'une proposition: c'est bourrin, mais efficace.
Programme principal:
Sub classement()
Dim nbclubs, nbcoureurs, CeClub as Range
nbclubs= 0
nbcoureurs=0
Set CeClub=Range("B2")
Do Until CeClub =""
If EstDansLaListe(CeClub) = False then
Range("D2").Offset(nbclubs)=CeClub.Value (inscription du club dans la liste)
nbcoureurs = Combien2Coureurs(CeClub)
(inscription du nb de coureurs correspondant : )
Range("E2").Offset(nbclubs)=nbcoureurs
nbclubs = nbclubs +1
End If
CeClub = Ceclub.Offset(1)
Loop
End Sub
------------
Function Combien2Coureurs(CeClub as Range) as Integer
(nb de coureurs inscrits dans CeClub dans ton classement scratch(colonneB1))
dim i, nbcoureurs
i=0
coureurs =0
for i = CeClub.Row to CeClub.End(xlDown).Row if Cells(i,CeClub.Column).Value CeClub.Value then coureurs coureurs +1
next i
Combien2Coureurs = nbcoureurs
End Function
-------------
Function EstDansLaListe(CeClub as Range) as Boolean
(Test de l'existence de CeClub dans la liste des clubs participants (colonne D1))
dim i
i=0
EstDansLaListe=True
for i = Range("D2").Row to Range("D2").End(xlDown) if Cells(i,4).Value CeClub.Value then i i +1
next iif i 0 then EstDansLaListeFalse
End Function
Je suis certain que des méthodes tout aussi efficaces mais bcp plus rapides doivent exister (je pense à l'utilisation des filtres automatiques, ou à une réorganisation plus compacte de ce bout de code), mais je ne les ai pas en tête pour le moment.
J'espère que cela répond à tes attentes.
Amateurement vôtre...
ce n'est qu'une proposition: c'est bourrin, mais efficace.
Programme principal:
Sub classement()
Dim nbclubs, nbcoureurs, CeClub as Range
nbclubs= 0
nbcoureurs=0
Set CeClub=Range("B2")
Do Until CeClub =""
If EstDansLaListe(CeClub) = False then
Range("D2").Offset(nbclubs)=CeClub.Value (inscription du club dans la liste)
nbcoureurs = Combien2Coureurs(CeClub)
(inscription du nb de coureurs correspondant : )
Range("E2").Offset(nbclubs)=nbcoureurs
nbclubs = nbclubs +1
End If
CeClub = Ceclub.Offset(1)
Loop
End Sub
------------
Function Combien2Coureurs(CeClub as Range) as Integer
(nb de coureurs inscrits dans CeClub dans ton classement scratch(colonneB1))
dim i, nbcoureurs
i=0
coureurs =0
for i = CeClub.Row to CeClub.End(xlDown).Row if Cells(i,CeClub.Column).Value CeClub.Value then coureurs coureurs +1
next i
Combien2Coureurs = nbcoureurs
End Function
-------------
Function EstDansLaListe(CeClub as Range) as Boolean
(Test de l'existence de CeClub dans la liste des clubs participants (colonne D1))
dim i
i=0
EstDansLaListe=True
for i = Range("D2").Row to Range("D2").End(xlDown) if Cells(i,4).Value CeClub.Value then i i +1
next iif i 0 then EstDansLaListeFalse
End Function
Je suis certain que des méthodes tout aussi efficaces mais bcp plus rapides doivent exister (je pense à l'utilisation des filtres automatiques, ou à une réorganisation plus compacte de ce bout de code), mais je ne les ai pas en tête pour le moment.
J'espère que cela répond à tes attentes.
Amateurement vôtre...
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
cs_AbriBus
Messages postés
492
Date d'inscription
jeudi 28 août 2003
Statut
Membre
Dernière intervention
25 avril 2007
5
11 avril 2005 à 12:49
11 avril 2005 à 12:49
Je crois finalement que "Bourrin mais efficace" resume assez bien le Vba...
jpleroisse
Messages postés
1788
Date d'inscription
mardi 7 novembre 2000
Statut
Membre
Dernière intervention
11 mars 2006
27
11 avril 2005 à 16:21
11 avril 2005 à 16:21
Merci pour ta réponse nico39, j'ai essayé ta formule, mais j'ai une boucle sans fin , j'ai transformé un peu, mais là le code ne met q'un seul club et m'éfface les autres .
Enfin je vais chercher en modifiant ta formule.
Si de ton côté tu as quelques minutes a consacrer pour trouver la solution.?
jpleroisse
Enfin je vais chercher en modifiant ta formule.
Si de ton côté tu as quelques minutes a consacrer pour trouver la solution.?
jpleroisse
jpleroisse
Messages postés
1788
Date d'inscription
mardi 7 novembre 2000
Statut
Membre
Dernière intervention
11 mars 2006
27
11 avril 2005 à 19:22
11 avril 2005 à 19:22
Merci AbriBus d'avoir passer du temps a essayer de m'aider, je vais tirer mon plan pour comprendre ta fonction, car recopiée comme cela , il n'y a que le 1er club de sélectionné, on dirait que la boucle ne retient pas les autres noms.
Enfin reMerci , j'ai un départ pour trouver la solution (peut-être)
jpleroisse
Enfin reMerci , j'ai un départ pour trouver la solution (peut-être)
jpleroisse
cs_AbriBus
Messages postés
492
Date d'inscription
jeudi 28 août 2003
Statut
Membre
Dernière intervention
25 avril 2007
5
11 avril 2005 à 20:30
11 avril 2005 à 20:30
comme je t'ai dis... j'ai pas de compilo sous la main... alors en général, apres avoir ecrit un truc comme ca je l'execute au pas a pas avec des point d'arret... il y a peut ete des conneries dans les variables... le mode pas a pas c'est utile pour ca...
en outre, j'ai oublié de precisé mais il y a quelques petites contraintes, nottament que TOUS les coureurs DOIVENT avoir un club (pas de cellule $Bn vide sinon, ca arrete la boucle)
Bonne chance, bon courrage, bonne prog...
@BriBus
en outre, j'ai oublié de precisé mais il y a quelques petites contraintes, nottament que TOUS les coureurs DOIVENT avoir un club (pas de cellule $Bn vide sinon, ca arrete la boucle)
Bonne chance, bon courrage, bonne prog...
@BriBus
cs_nico39
Messages postés
56
Date d'inscription
vendredi 4 mars 2005
Statut
Membre
Dernière intervention
4 octobre 2006
12 avril 2005 à 10:08
12 avril 2005 à 10:08
Salut jpleroisse et AbriBus,
Bien vu, AbriBus: il faut impérativement que tous les coureurs soient rattachés à un club (ou sinon NonLicencié)!!!!
Voici les modifications de mon bout de code: il tourne sans trop de problème (une ligne apparaît en plus à la fin de la liste des clubs), mais les clubs participants sont listés parfaitement, avec le nombre de leurs participants.
Ainsi, dans le programme principal,
rajoute Set devant CeClub = CeClub.Offset(1)
Dans la function Combien2Coureurs, réajuste le nom de la variable " nb coureurs" partout dans le code. (désolé, j'ai tapé un peu trop vite la première fois...)
Pour la function EstDansLaListe, remplace-la par:
Dim i, occurrence
occurrence = 0
EstDansLaListe = True
i = 0
Do If Cells(i + 2, 4).Value CeClub.Value Then occurrence occurrence + 1
i = i + 1
Loop Until Range("D2").Offset(i) = ""If occurrence 0 Then EstDansLaListe False
End Function
Je crois que ce sont les seules modifications à apporter. Je garantis le résultat (ai testé sur une liste bidon de 20 coureurs et 4 clubs: très bon résultat). Il y a juste cette ligne supplémentaire qui se rajoute, mais ça n'handicape absolument pas le résultat final.
Je ne sais pas ce qui peut générer cette ligne supplémentaire; j'ai bien essayé de regarder plus en dedans, mais bon... Je continue de chercher.
J'espère que ça réponds à tes attentes, jpleroisse.
En attendant, bonne course !!!!!
Amateurement vôtre...
Bien vu, AbriBus: il faut impérativement que tous les coureurs soient rattachés à un club (ou sinon NonLicencié)!!!!
Voici les modifications de mon bout de code: il tourne sans trop de problème (une ligne apparaît en plus à la fin de la liste des clubs), mais les clubs participants sont listés parfaitement, avec le nombre de leurs participants.
Ainsi, dans le programme principal,
rajoute Set devant CeClub = CeClub.Offset(1)
Dans la function Combien2Coureurs, réajuste le nom de la variable " nb coureurs" partout dans le code. (désolé, j'ai tapé un peu trop vite la première fois...)
Pour la function EstDansLaListe, remplace-la par:
Dim i, occurrence
occurrence = 0
EstDansLaListe = True
i = 0
Do If Cells(i + 2, 4).Value CeClub.Value Then occurrence occurrence + 1
i = i + 1
Loop Until Range("D2").Offset(i) = ""If occurrence 0 Then EstDansLaListe False
End Function
Je crois que ce sont les seules modifications à apporter. Je garantis le résultat (ai testé sur une liste bidon de 20 coureurs et 4 clubs: très bon résultat). Il y a juste cette ligne supplémentaire qui se rajoute, mais ça n'handicape absolument pas le résultat final.
Je ne sais pas ce qui peut générer cette ligne supplémentaire; j'ai bien essayé de regarder plus en dedans, mais bon... Je continue de chercher.
J'espère que ça réponds à tes attentes, jpleroisse.
En attendant, bonne course !!!!!
Amateurement vôtre...
jpleroisse
Messages postés
1788
Date d'inscription
mardi 7 novembre 2000
Statut
Membre
Dernière intervention
11 mars 2006
27
12 avril 2005 à 14:59
12 avril 2005 à 14:59
Merci à tous pour vos réponses et le temps que vous avez passé pour m'aider, la formule marche très bien. Pour la ligne supplémentaire, j'ai juste mis Delete pour la dernière ligne, voilà.
Le plus dur c'est d'attibuer Réponse Acceptée à l'un de vous, allez je vais l'attribuer a AbriBus.
Remerci à vous deux.
@+ jpleroisse
Le plus dur c'est d'attibuer Réponse Acceptée à l'un de vous, allez je vais l'attribuer a AbriBus.
Remerci à vous deux.
@+ jpleroisse
cs_AbriBus
Messages postés
492
Date d'inscription
jeudi 28 août 2003
Statut
Membre
Dernière intervention
25 avril 2007
5
14 avril 2005 à 05:16
14 avril 2005 à 05:16
Merci
Je crois que le plus important c'est qu'il y ait au moins une reponse acceptée comme ca au moins le topic est montré comme "solutionné".
De plus, je crois bien que au final nico39 et moi avons réalisé deux bouts de code similaire (ca tombe bien, l'objectif était commun ). peut etre j'ai mis un peu plus de comments . Bref, le principal c'est que ca marche (ou plutot ca cour LOL)... bon courrage, et bonne prog à vous...
@BriBus
Je crois que le plus important c'est qu'il y ait au moins une reponse acceptée comme ca au moins le topic est montré comme "solutionné".
De plus, je crois bien que au final nico39 et moi avons réalisé deux bouts de code similaire (ca tombe bien, l'objectif était commun ). peut etre j'ai mis un peu plus de comments . Bref, le principal c'est que ca marche (ou plutot ca cour LOL)... bon courrage, et bonne prog à vous...
@BriBus
