Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel pb dans une proc

pb dans une proc

5 réponses
Avatar
Louis
Bonjour, un TGC très gentil contributeur, m'a fournit cette proc qui ne
fonctionne pas et plante quasiment partout, j'ai beau essayer, je n'y arrive
pas.
Un autre TGC peut-il m'aider ?
Merci
Louis

public sub gagnant()

do while (cells(x,1) <> "") 'Va looper toute les lignes tant qu<il ne
rencontre pas de ligne vide
if cells(x,2) > cells(x,4) then 'Premiere equipe gagne
for y = 1 to 4 'dison quon a 4 equipes
if sheet("resultat").cells(y,1) = cells(x,1) then
'trouve la bonne equipe dans la liste des 4
sheet("resultat").cells(y,2) = sheet("resultat").cells(y,2)
+ 1 'incremente le nombre de victoire de 1
end if
next
end if
if cells(x,2) < cells(x,4) then 'deuxieme equipe gagne
for y = 1 to 4 'dison quon a 4 equipes
if sheet("resultat").cells(y,1) = cells(x,1) then
'trouve la bonne equipe dans la liste des 4
sheet("resultat").cells(y,2) = sheet("resultat").cells(y,2)
+ 1 'incremente le nombre de victoire de 1
end if
next
end if
loop
Signaler un problème avec ce contenu

5 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Pascal Engelmajer
Salut,
cette procédure est incorrecte :
x n'est jamais incrémenté.
Sheet("resultat") au lieu de Sheets("resultat")
Voici une version sans ambiguïté qui reprend le style de programmation...
Option Explicit
Public Sub gagnant()
Dim i As Integer ' Ligne de la cellule feuille de travail
Dim j As Integer ' Ligne de la cellule feuille "resultat"
Dim shs As Worksheet ' Feuille active avec la saisie
Dim shr As Worksheet 'feuille "resultat"
Set shr = Sheets("resultat")
Set shs = ActiveSheet ' ou Sheets("SonNom")
i = 0

Do While shs.Cells(i, 1) <> ""
i = i + 1
'Va boucler sur toute les lignes tant qu'il ne rencontre pas de
ligne vide
If shs.Cells(i, 2) > shs.Cells(i, 4) Then
'Première équipe gagne
'Boucle dans la feuille "resultat"
For j = 1 To 4
'Disons qu'on a quatre équipes
If shr.Cells(j, 1) = shs.Cells(i, 1) Then
'Trouve la bonne équipe dans la liste des quatre
shr.Cells(j, 2) = shr.Cells(j, 2) + 1
'Incrémente le nombre de victoires de un
End If
Next
End If
If shs.Cells(i, 2) < shs.Cells(i, 4) Then
'Deuxième équipe gagne
For j = 1 To 4
'Disons qu'on a quatre équipes
If shr.Cells(j, 1) = shs.Cells(i, 1) Then
'Trouve la bonne équipe dans la liste des quatre
shr.Cells(j, 2) = shr.Cells(j, 2) + 1
'Incrémente le nombre de victoires de un
End If
Next
End If
Loop
End Sub

--
Amicalement.
Pascal
"il n'y a pas de vent favorable pour celui qui ne sait pas ou il va."
Sénèque.
http://www.ilyapa.net/excel
"Louis" a écrit dans le message de news:

Bonjour, un TGC très gentil contributeur, m'a fournit cette proc qui ne
fonctionne pas et plante quasiment partout, j'ai beau essayer, je n'y
arrive

pas.
Un autre TGC peut-il m'aider ?
Merci
Louis

public sub gagnant()

do while (cells(x,1) <> "") 'Va looper toute les lignes tant qu<il
ne

rencontre pas de ligne vide
if cells(x,2) > cells(x,4) then 'Premiere equipe gagne
for y = 1 to 4 'dison quon a 4 equipes
if sheet("resultat").cells(y,1) = cells(x,1) then
'trouve la bonne equipe dans la liste des 4
sheet("resultat").cells(y,2) sheet("resultat").cells(y,2)
+ 1 'incremente le nombre de victoire de 1
end if
next
end if
if cells(x,2) < cells(x,4) then 'deuxieme equipe gagne
for y = 1 to 4 'dison quon a 4 equipes
if sheet("resultat").cells(y,1) = cells(x,1) then
'trouve la bonne equipe dans la liste des 4
sheet("resultat").cells(y,2) sheet("resultat").cells(y,2)
+ 1 'incremente le nombre de victoire de 1
end if
next
end if
loop




Avatar
LeSteph
Bonjour,
Tels que!c'est plein d'erreurs.
Il ya minimalement des pb de coupe par largeur de page d'outlook ou autre
outil de messagerie.
A priori les commentaires dépassent et des lignes sont coupées.
Dans ton module rien ne doit apparaitre en rouge
le petit ' sert aux commentaires qui apparaissent en vert et doivent rester
à sa droite
[Ex: 'Va looper tt les lignes tant......vide] doit rester d'un seul tenant
sur la même ligne.
Il ya '+1' qui devrait rester juste derrière cells(y,2)
...et...autres..syntaxe§§
De plus après fin de boucle 'loop' il doit y avoir au moins qq chose qui
termine par End Sub

Si tu redonnes le pb initial on essaie de la refaire.

LeSteph

"Louis" a écrit dans le message de
news:
Bonjour, un TGC très gentil contributeur, m'a fournit cette proc qui ne
fonctionne pas et plante quasiment partout, j'ai beau essayer, je n'y
arrive

pas.
Un autre TGC peut-il m'aider ?
Merci
Louis

public sub gagnant()

do while (cells(x,1) <> "") 'Va looper toute les lignes tant qu<il
ne

rencontre pas de ligne vide
if cells(x,2) > cells(x,4) then 'Premiere equipe gagne
for y = 1 to 4 'dison quon a 4 equipes
if sheet("resultat").cells(y,1) = cells(x,1) then
'trouve la bonne equipe dans la liste des 4
sheet("resultat").cells(y,2) sheet("resultat").cells(y,2)
+ 1 'incremente le nombre de victoire de 1
end if
next
end if
if cells(x,2) < cells(x,4) then 'deuxieme equipe gagne
for y = 1 to 4 'dison quon a 4 equipes
if sheet("resultat").cells(y,1) = cells(x,1) then
'trouve la bonne equipe dans la liste des 4
sheet("resultat").cells(y,2) sheet("resultat").cells(y,2)
+ 1 'incremente le nombre de victoire de 1
end if
next
end if
loop




Avatar
LeSteph
Pardon Pascal je vois que tu as déjà répondu...bonne journée!

LeSteph



"LeSteph" a écrit dans le message de
news:40a5dd65$0$31380$
Bonjour,
Tels que!c'est plein d'erreurs.
Il ya minimalement des pb de coupe par largeur de page d'outlook ou autre
outil de messagerie.
A priori les commentaires dépassent et des lignes sont coupées.
Dans ton module rien ne doit apparaitre en rouge
le petit ' sert aux commentaires qui apparaissent en vert et doivent
rester

à sa droite
[Ex: 'Va looper tt les lignes tant......vide] doit rester d'un seul tenant
sur la même ligne.
Il ya '+1' qui devrait rester juste derrière cells(y,2)
...et...autres..syntaxe§§
De plus après fin de boucle 'loop' il doit y avoir au moins qq chose qui
termine par End Sub

Si tu redonnes le pb initial on essaie de la refaire.

LeSteph

"Louis" a écrit dans le message de
news:
Bonjour, un TGC très gentil contributeur, m'a fournit cette proc qui ne
fonctionne pas et plante quasiment partout, j'ai beau essayer, je n'y
arrive

pas.
Un autre TGC peut-il m'aider ?
Merci
Louis

public sub gagnant()

do while (cells(x,1) <> "") 'Va looper toute les lignes tant
qu<il


ne
rencontre pas de ligne vide
if cells(x,2) > cells(x,4) then 'Premiere equipe gagne
for y = 1 to 4 'dison quon a 4 equipes
if sheet("resultat").cells(y,1) = cells(x,1) then
'trouve la bonne equipe dans la liste des 4
sheet("resultat").cells(y,2) > sheet("resultat").cells(y,2)
+ 1 'incremente le nombre de victoire de 1
end if
next
end if
if cells(x,2) < cells(x,4) then 'deuxieme equipe gagne
for y = 1 to 4 'dison quon a 4 equipes
if sheet("resultat").cells(y,1) = cells(x,1) then
'trouve la bonne equipe dans la liste des 4
sheet("resultat").cells(y,2) > sheet("resultat").cells(y,2)
+ 1 'incremente le nombre de victoire de 1
end if
next
end if
loop








Avatar
Louis
Euh...
Merci beaucoup Pascal
La proc plante au niveau du "Do while"
Louis


"Pascal Engelmajer" a écrit dans le
message de news:
Salut,
cette procédure est incorrecte :
x n'est jamais incrémenté.
Sheet("resultat") au lieu de Sheets("resultat")
Voici une version sans ambiguïté qui reprend le style de programmation...
Option Explicit
Public Sub gagnant()
Dim i As Integer ' Ligne de la cellule feuille de travail
Dim j As Integer ' Ligne de la cellule feuille "resultat"
Dim shs As Worksheet ' Feuille active avec la saisie
Dim shr As Worksheet 'feuille "resultat"
Set shr = Sheets("resultat")
Set shs = ActiveSheet ' ou Sheets("SonNom")
i = 0

Do While shs.Cells(i, 1) <> ""
i = i + 1
'Va boucler sur toute les lignes tant qu'il ne rencontre pas de
ligne vide
If shs.Cells(i, 2) > shs.Cells(i, 4) Then
'Première équipe gagne
'Boucle dans la feuille "resultat"
For j = 1 To 4
'Disons qu'on a quatre équipes
If shr.Cells(j, 1) = shs.Cells(i, 1) Then
'Trouve la bonne équipe dans la liste des quatre
shr.Cells(j, 2) = shr.Cells(j, 2) + 1
'Incrémente le nombre de victoires de un
End If
Next
End If
If shs.Cells(i, 2) < shs.Cells(i, 4) Then
'Deuxième équipe gagne
For j = 1 To 4
'Disons qu'on a quatre équipes
If shr.Cells(j, 1) = shs.Cells(i, 1) Then
'Trouve la bonne équipe dans la liste des quatre
shr.Cells(j, 2) = shr.Cells(j, 2) + 1
'Incrémente le nombre de victoires de un
End If
Next
End If
Loop
End Sub

--
Amicalement.
Pascal
"il n'y a pas de vent favorable pour celui qui ne sait pas ou il va."
Sénèque.
http://www.ilyapa.net/excel
"Louis" a écrit dans le message de news:

Bonjour, un TGC très gentil contributeur, m'a fournit cette proc qui ne
fonctionne pas et plante quasiment partout, j'ai beau essayer, je n'y
arrive

pas.
Un autre TGC peut-il m'aider ?
Merci
Louis

public sub gagnant()

do while (cells(x,1) <> "") 'Va looper toute les lignes tant
qu<il


ne
rencontre pas de ligne vide
if cells(x,2) > cells(x,4) then 'Premiere equipe gagne
for y = 1 to 4 'dison quon a 4 equipes
if sheet("resultat").cells(y,1) = cells(x,1) then
'trouve la bonne equipe dans la liste des 4
sheet("resultat").cells(y,2) > sheet("resultat").cells(y,2)
+ 1 'incremente le nombre de victoire de 1
end if
next
end if
if cells(x,2) < cells(x,4) then 'deuxieme equipe gagne
for y = 1 to 4 'dison quon a 4 equipes
if sheet("resultat").cells(y,1) = cells(x,1) then
'trouve la bonne equipe dans la liste des 4
sheet("resultat").cells(y,2) > sheet("resultat").cells(y,2)
+ 1 'incremente le nombre de victoire de 1
end if
next
end if
loop








Avatar
Louis
Merci beaucoup
Louis

"LeSteph" a écrit dans le message de
news:40a5dd65$0$31380$
Bonjour,
Tels que!c'est plein d'erreurs.
Il ya minimalement des pb de coupe par largeur de page d'outlook ou autre
outil de messagerie.
A priori les commentaires dépassent et des lignes sont coupées.
Dans ton module rien ne doit apparaitre en rouge
le petit ' sert aux commentaires qui apparaissent en vert et doivent
rester

à sa droite
[Ex: 'Va looper tt les lignes tant......vide] doit rester d'un seul tenant
sur la même ligne.
Il ya '+1' qui devrait rester juste derrière cells(y,2)
...et...autres..syntaxe§§
De plus après fin de boucle 'loop' il doit y avoir au moins qq chose qui
termine par End Sub

Si tu redonnes le pb initial on essaie de la refaire.

LeSteph

"Louis" a écrit dans le message de
news:
Bonjour, un TGC très gentil contributeur, m'a fournit cette proc qui ne
fonctionne pas et plante quasiment partout, j'ai beau essayer, je n'y
arrive

pas.
Un autre TGC peut-il m'aider ?
Merci
Louis

public sub gagnant()

do while (cells(x,1) <> "") 'Va looper toute les lignes tant
qu<il


ne
rencontre pas de ligne vide
if cells(x,2) > cells(x,4) then 'Premiere equipe gagne
for y = 1 to 4 'dison quon a 4 equipes
if sheet("resultat").cells(y,1) = cells(x,1) then
'trouve la bonne equipe dans la liste des 4
sheet("resultat").cells(y,2) > sheet("resultat").cells(y,2)
+ 1 'incremente le nombre de victoire de 1
end if
next
end if
if cells(x,2) < cells(x,4) then 'deuxieme equipe gagne
for y = 1 to 4 'dison quon a 4 equipes
if sheet("resultat").cells(y,1) = cells(x,1) then
'trouve la bonne equipe dans la liste des 4
sheet("resultat").cells(y,2) > sheet("resultat").cells(y,2)
+ 1 'incremente le nombre de victoire de 1
end if
next
end if
loop